From a666fe97fa06d825d362efd2496eb8720338c005 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 28 Apr 2021 11:06:16 +0300 Subject: [PATCH 01/81] Init mlab repo. Setup build tools --- mlabs/.gitignore | 1 + mlabs/CHANGELOG.md | 5 + mlabs/Makefile | 21 ++++ mlabs/Setup.hs | 2 + mlabs/app/Main.hs | 4 + mlabs/mlabs-plutus-use-cases.cabal | 83 ++++++++++++++ mlabs/nix/default.nix | 9 ++ mlabs/nix/pab.nix | 42 +++++++ mlabs/nix/pab_conf.nix | 38 +++++++ mlabs/nix/sources.json | 38 +++++++ mlabs/nix/sources.nix | 174 +++++++++++++++++++++++++++++ mlabs/shell.nix | 48 ++++++++ mlabs/src/Mlabs/Lending.hs | 5 + mlabs/test/Main.hs | 4 + mlabs/test/Test/Lending.hs | 7 ++ 15 files changed, 481 insertions(+) create mode 100644 mlabs/.gitignore create mode 100644 mlabs/CHANGELOG.md create mode 100644 mlabs/Makefile create mode 100644 mlabs/Setup.hs create mode 100644 mlabs/app/Main.hs create mode 100644 mlabs/mlabs-plutus-use-cases.cabal create mode 100644 mlabs/nix/default.nix create mode 100644 mlabs/nix/pab.nix create mode 100644 mlabs/nix/pab_conf.nix create mode 100644 mlabs/nix/sources.json create mode 100644 mlabs/nix/sources.nix create mode 100644 mlabs/shell.nix create mode 100644 mlabs/src/Mlabs/Lending.hs create mode 100644 mlabs/test/Main.hs create mode 100644 mlabs/test/Test/Lending.hs diff --git a/mlabs/.gitignore b/mlabs/.gitignore new file mode 100644 index 000000000..c33954f53 --- /dev/null +++ b/mlabs/.gitignore @@ -0,0 +1 @@ +dist-newstyle/ diff --git a/mlabs/CHANGELOG.md b/mlabs/CHANGELOG.md new file mode 100644 index 000000000..10169f277 --- /dev/null +++ b/mlabs/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for mlabs + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/mlabs/Makefile b/mlabs/Makefile new file mode 100644 index 000000000..bdd0712c0 --- /dev/null +++ b/mlabs/Makefile @@ -0,0 +1,21 @@ + +hoogle: requires_nix_shell + hoogle server --local --port 8008 + +build: requires_nix_shell + cabal build all + +repl: requires_nix_shell + cabal new-repl + +test: requires_nix_shell + cabal test all + +watch: requires_nix_shell + ghcid "-c cabal new-repl" + +# Target to use as dependency to fail if not inside nix-shell +requires_nix_shell: + @ [ -v IN_NIX_SHELL ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" + @ [ -v IN_NIX_SHELL ] || (echo " run 'nix-shell --pure' first" && false) + diff --git a/mlabs/Setup.hs b/mlabs/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/mlabs/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/mlabs/app/Main.hs b/mlabs/app/Main.hs new file mode 100644 index 000000000..65ae4a05d --- /dev/null +++ b/mlabs/app/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal new file mode 100644 index 000000000..b47cbd2b9 --- /dev/null +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -0,0 +1,83 @@ +cabal-version: >=1.10 +-- Initial package description 'mlabs-plutus-use-cases.cabal' generated by 'cabal init'. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: mlabs-plutus-use-caases +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +-- license: +license-file: LICENSE +author: mlabs +maintainer: anton@mlabs.gmail +-- copyright: +-- category: +build-type: Simple +extra-source-files: CHANGELOG.md +Hs-Source-Dirs: src/ + + +library + Ghc-Options: -Wall + build-depends: base >=4.14 && <4.15 + , aeson + , bytestring + , containers + , playground-common + , plutus-core + , plutus-contract + , plutus-ledger + , plutus-tx + , plutus-tx-plugin + , plutus-pab + , prettyprinter + , lens + , text + , freer-extras + default-language: Haskell2010 + hs-source-dirs: src/ + exposed-modules: + Mlabs.Lending + +executable mlabs-plutus-use-caases + main-is: Main.hs + hs-source-dirs: app/ + -- other-modules: + -- other-extensions: + build-depends: base >=4.14 && <4.15 + , aeson + , bytestring + , containers + , playground-common + , plutus-core + , plutus-contract + , plutus-ledger + , plutus-tx + , plutus-tx-plugin + , plutus-pab + , prettyprinter + , lens + , text + , freer-extras + -- hs-source-dirs: + default-language: Haskell2010 + + +Test-suite mlabs-plutus-use-cases-tests + Type: exitcode-stdio-1.0 + Ghc-options: -Wall -threaded -rtsopts + Default-Language: Haskell2010 + Build-Depends: base >=4.9 && <5 + , mlabs-plutus-use-cases + , text + , tasty + , tasty-hunit + hs-source-dirs: test + Main-is: Main.hs + Other-modules: Test.Lending + default-extensions: + RecordWildCards + OverloadedStrings + QuasiQuotes + diff --git a/mlabs/nix/default.nix b/mlabs/nix/default.nix new file mode 100644 index 000000000..35e7057b3 --- /dev/null +++ b/mlabs/nix/default.nix @@ -0,0 +1,9 @@ +{ sourcesFile ? ./sources.json, system ? builtins.currentSystem }: rec { + sources = import ./sources.nix { inherit sourcesFile system; }; + plutus = import sources.plutus { + # See: https://github.com/input-output-hk/plutus/blob/893a887eac83409131b2038820a14962c6796776/ci.nix#L5 + rev = "fake"; + }; + pkgs = plutus.pkgs; + pab = import ./pab.nix { inherit plutus; }; +} diff --git a/mlabs/nix/pab.nix b/mlabs/nix/pab.nix new file mode 100644 index 000000000..5e53cd349 --- /dev/null +++ b/mlabs/nix/pab.nix @@ -0,0 +1,42 @@ +{ plutus, pkgs ? plutus.pkgs }: rec { + # PAB setup + plutus_pab_exes = plutus.plutus-pab.pab-exes; + plutus_pab_client = plutus.plutus-pab.client; + + plutus_pab_db_path = "/tmp"; + plutus_pab_confs = import ./pab_conf.nix { + db-path = plutus_pab_db_path; + client = plutus_pab_client; + }; + + # Annoyingly, the mkConf from Pab has a fixed name... + # The plutus build by default misses this + plutus_pab_conf_dir = with plutus_pab_confs; + pkgs.linkFarm "plutus_pab_envs" [ + + { + inherit (pab_env1) name; + path = plutus.plutus-pab.mkConf pab_env1; + } + + { + inherit (pab_env2) name; + path = plutus.plutus-pab.mkConf pab_env2; + } + + ]; + + plutus_ledger_with_docs = + plutus.plutus.haskell.packages.plutus-ledger.components.library.override { + doHaddock = true; + configureFlags = [ "-f defer-plugin-errors" ]; + }; + + env_variables = { + PAB_CONFIG_PATH = plutus_pab_conf_dir; + PAB_CLIENT_PATH = plutus_pab_client; + PAB_DB1_PATH = plutus_pab_confs.pab_env1.db-file; + PAB_DB2_PATH = plutus_pab_confs.pab_env2.db-file; + }; + +} diff --git a/mlabs/nix/pab_conf.nix b/mlabs/nix/pab_conf.nix new file mode 100644 index 000000000..7db15dc46 --- /dev/null +++ b/mlabs/nix/pab_conf.nix @@ -0,0 +1,38 @@ +# This set is fed in as arguments to a derivation which +# generates a config file. +{ nodeserver-port ? "9082", client, db-path ? "./.tmp" }: { + pab_env1 = { + inherit client nodeserver-port; + name = "pab_env1.yaml"; + + # DB + db-file = "${db-path}/pab_env1.db"; + + # Ports + webserver-port = "9080"; + walletserver-port = "9081"; + chain-index-port = "9083"; + signing-process-port = "9084"; + metadata-server-port = "9085"; + + # Wallet 1 + wallet = "1"; + }; + + pab_env2 = { + inherit client nodeserver-port; + name = "pab_env2.yaml"; + + # DB + db-file = "${db-path}/pab_env2.db"; + + webserver-port = "9090"; + walletserver-port = "9091"; + chain-index-port = "9093"; + signing-process-port = "9094"; + metadata-server-port = "9095"; + + wallet = "2"; + }; + +} diff --git a/mlabs/nix/sources.json b/mlabs/nix/sources.json new file mode 100644 index 000000000..7a08dcf86 --- /dev/null +++ b/mlabs/nix/sources.json @@ -0,0 +1,38 @@ +{ + "niv": { + "branch": "master", + "description": "Easy dependency management for Nix projects", + "homepage": "https://github.com/nmattia/niv", + "owner": "nmattia", + "repo": "niv", + "rev": "af958e8057f345ee1aca714c1247ef3ba1c15f5e", + "sha256": "1qjavxabbrsh73yck5dcq8jggvh3r2jkbr6b5nlz5d9yrqm9255n", + "type": "tarball", + "url": "https://github.com/nmattia/niv/archive/af958e8057f345ee1aca714c1247ef3ba1c15f5e.tar.gz", + "url_template": "https://github.com///archive/.tar.gz" + }, + "nixpkgs": { + "branch": "release-20.03", + "description": "Nix Packages collection", + "homepage": "", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "6d1a044fc9ff3cc96fca5fa3ba9c158522bbf2a5", + "sha256": "07a3nyrj3pwl017ig0rbn5rbmbf14gl3vqggvkyrdby01726p5fg", + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/6d1a044fc9ff3cc96fca5fa3ba9c158522bbf2a5.tar.gz", + "url_template": "https://github.com///archive/.tar.gz" + }, + "plutus": { + "branch": "master", + "description": "The Plutus language implementation and tools", + "homepage": "", + "owner": "input-output-hk", + "repo": "plutus", + "rev": "62be7a2d6dff285ad72d5bc6f5f11991ffae888b", + "sha256": "05l6iw0gp8l8b940552c5dcsc70amynmkcjpa63j9gr61izqaf58", + "type": "tarball", + "url": "https://github.com/input-output-hk/plutus/archive/62be7a2d6dff285ad72d5bc6f5f11991ffae888b.tar.gz", + "url_template": "https://github.com///archive/.tar.gz" + } +} diff --git a/mlabs/nix/sources.nix b/mlabs/nix/sources.nix new file mode 100644 index 000000000..1938409dd --- /dev/null +++ b/mlabs/nix/sources.nix @@ -0,0 +1,174 @@ +# This file has been generated by Niv. + +let + + # + # The fetchers. fetch_ fetches specs of type . + # + + fetch_file = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in + if spec.builtin or true then + builtins_fetchurl { inherit (spec) url sha256; name = name'; } + else + pkgs.fetchurl { inherit (spec) url sha256; name = name'; }; + + fetch_tarball = pkgs: name: spec: + let + name' = sanitizeName name + "-src"; + in + if spec.builtin or true then + builtins_fetchTarball { name = name'; inherit (spec) url sha256; } + else + pkgs.fetchzip { name = name'; inherit (spec) url sha256; }; + + fetch_git = name: spec: + let + ref = + if spec ? ref then spec.ref else + if spec ? branch then "refs/heads/${spec.branch}" else + if spec ? tag then "refs/tags/${spec.tag}" else + abort "In git source '${name}': Please specify `ref`, `tag` or `branch`!"; + in + builtins.fetchGit { url = spec.repo; inherit (spec) rev; inherit ref; }; + + fetch_local = spec: spec.path; + + fetch_builtin-tarball = name: throw + ''[${name}] The niv type "builtin-tarball" is deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=tarball -a builtin=true''; + + fetch_builtin-url = name: throw + ''[${name}] The niv type "builtin-url" will soon be deprecated. You should instead use `builtin = true`. + $ niv modify ${name} -a type=file -a builtin=true''; + + # + # Various helpers + # + + # https://github.com/NixOS/nixpkgs/pull/83241/files#diff-c6f540a4f3bfa4b0e8b6bafd4cd54e8bR695 + sanitizeName = name: + ( + concatMapStrings (s: if builtins.isList s then "-" else s) + ( + builtins.split "[^[:alnum:]+._?=-]+" + ((x: builtins.elemAt (builtins.match "\\.*(.*)" x) 0) name) + ) + ); + + # The set of packages used when specs are fetched using non-builtins. + mkPkgs = sources: system: + let + sourcesNixpkgs = + import (builtins_fetchTarball { inherit (sources.nixpkgs) url sha256; }) { inherit system; }; + hasNixpkgsPath = builtins.any (x: x.prefix == "nixpkgs") builtins.nixPath; + hasThisAsNixpkgsPath = == ./.; + in + if builtins.hasAttr "nixpkgs" sources + then sourcesNixpkgs + else if hasNixpkgsPath && ! hasThisAsNixpkgsPath then + import {} + else + abort + '' + Please specify either (through -I or NIX_PATH=nixpkgs=...) or + add a package called "nixpkgs" to your sources.json. + ''; + + # The actual fetching function. + fetch = pkgs: name: spec: + + if ! builtins.hasAttr "type" spec then + abort "ERROR: niv spec ${name} does not have a 'type' attribute" + else if spec.type == "file" then fetch_file pkgs name spec + else if spec.type == "tarball" then fetch_tarball pkgs name spec + else if spec.type == "git" then fetch_git name spec + else if spec.type == "local" then fetch_local spec + else if spec.type == "builtin-tarball" then fetch_builtin-tarball name + else if spec.type == "builtin-url" then fetch_builtin-url name + else + abort "ERROR: niv spec ${name} has unknown type ${builtins.toJSON spec.type}"; + + # If the environment variable NIV_OVERRIDE_${name} is set, then use + # the path directly as opposed to the fetched source. + replace = name: drv: + let + saneName = stringAsChars (c: if isNull (builtins.match "[a-zA-Z0-9]" c) then "_" else c) name; + ersatz = builtins.getEnv "NIV_OVERRIDE_${saneName}"; + in + if ersatz == "" then drv else + # this turns the string into an actual Nix path (for both absolute and + # relative paths) + if builtins.substring 0 1 ersatz == "/" then /. + ersatz else /. + builtins.getEnv "PWD" + "/${ersatz}"; + + # Ports of functions for older nix versions + + # a Nix version of mapAttrs if the built-in doesn't exist + mapAttrs = builtins.mapAttrs or ( + f: set: with builtins; + listToAttrs (map (attr: { name = attr; value = f attr set.${attr}; }) (attrNames set)) + ); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/lists.nix#L295 + range = first: last: if first > last then [] else builtins.genList (n: first + n) (last - first + 1); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L257 + stringToCharacters = s: map (p: builtins.substring p 1 s) (range 0 (builtins.stringLength s - 1)); + + # https://github.com/NixOS/nixpkgs/blob/0258808f5744ca980b9a1f24fe0b1e6f0fecee9c/lib/strings.nix#L269 + stringAsChars = f: s: concatStrings (map f (stringToCharacters s)); + concatMapStrings = f: list: concatStrings (map f list); + concatStrings = builtins.concatStringsSep ""; + + # https://github.com/NixOS/nixpkgs/blob/8a9f58a375c401b96da862d969f66429def1d118/lib/attrsets.nix#L331 + optionalAttrs = cond: as: if cond then as else {}; + + # fetchTarball version that is compatible between all the versions of Nix + builtins_fetchTarball = { url, name ? null, sha256 }@attrs: + let + inherit (builtins) lessThan nixVersion fetchTarball; + in + if lessThan nixVersion "1.12" then + fetchTarball ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; })) + else + fetchTarball attrs; + + # fetchurl version that is compatible between all the versions of Nix + builtins_fetchurl = { url, name ? null, sha256 }@attrs: + let + inherit (builtins) lessThan nixVersion fetchurl; + in + if lessThan nixVersion "1.12" then + fetchurl ({ inherit url; } // (optionalAttrs (!isNull name) { inherit name; })) + else + fetchurl attrs; + + # Create the final "sources" from the config + mkSources = config: + mapAttrs ( + name: spec: + if builtins.hasAttr "outPath" spec + then abort + "The values in sources.json should not have an 'outPath' attribute" + else + spec // { outPath = replace name (fetch config.pkgs name spec); } + ) config.sources; + + # The "config" used by the fetchers + mkConfig = + { sourcesFile ? if builtins.pathExists ./sources.json then ./sources.json else null + , sources ? if isNull sourcesFile then {} else builtins.fromJSON (builtins.readFile sourcesFile) + , system ? builtins.currentSystem + , pkgs ? mkPkgs sources system + }: rec { + # The sources, i.e. the attribute set of spec name to spec + inherit sources; + + # The "pkgs" (evaluated nixpkgs) to use for e.g. non-builtin fetchers + inherit pkgs; + }; + +in +mkSources (mkConfig {}) // { __functor = _: settings: mkSources (mkConfig settings); } diff --git a/mlabs/shell.nix b/mlabs/shell.nix new file mode 100644 index 000000000..ac5d69593 --- /dev/null +++ b/mlabs/shell.nix @@ -0,0 +1,48 @@ +with import ./nix { }; +(plutus.plutus.haskell.project.shellFor (pab.env_variables // { + + # Select packages who's dependencies should be added to the shell env + packages = ps: [ ]; + + # Select packages which should be added to the shell env, with their dependencies + # Should try and get the extra cardano dependencies in here... + additional = ps: + with ps; [ + plutus-pab + plutus-tx + plutus-tx-plugin + plutus-contract + plutus-ledger-api + pab.plutus_ledger_with_docs + plutus-core + playground-common + prettyprinter-configurable + plutus-use-cases + ]; + + withHoogle = true; + + # Extra haskell tools (arg passed on to mkDerivation) + # Using the plutus.pkgs to use nixpkgs version from plutus (nixpkgs-unstable, mostly) + propagatedBuildInputs = with pkgs; + [ + # Haskell Tools + stack + plutus.plutus.hlint + haskellPackages.fourmolu + git + ghc + nixfmt + + # Pab + pab.plutus_pab_client + + # Example contracts + plutus.plutus-currency + plutus.plutus-atomic-swap + + ] ++ (builtins.attrValues pab.plutus_pab_exes); + + buildInputs = [ plutus.pkgs.zlib ]; + +})) diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs new file mode 100644 index 000000000..db3e0af7a --- /dev/null +++ b/mlabs/src/Mlabs/Lending.hs @@ -0,0 +1,5 @@ +module Mlabs.Lending where + +import qualified PlutusTx.Prelude as Plutus + + diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs new file mode 100644 index 000000000..d82a4bd93 --- /dev/null +++ b/mlabs/test/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = return () diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs new file mode 100644 index 000000000..7af7be059 --- /dev/null +++ b/mlabs/test/Test/Lending.hs @@ -0,0 +1,7 @@ +module Test.Lending( + test +) where + +test :: Bool +test = True + From 829df49092eb838a5cf6f459710a7f290e0df625 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 28 Apr 2021 12:40:54 +0300 Subject: [PATCH 02/81] Lending create draft --- mlabs/mlabs-plutus-use-cases.cabal | 16 ++++++++- mlabs/src/Mlabs/Lending.hs | 57 +++++++++++++++++++++++++++++- 2 files changed, 71 insertions(+), 2 deletions(-) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index b47cbd2b9..91fbc3061 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -39,6 +39,21 @@ library hs-source-dirs: src/ exposed-modules: Mlabs.Lending + default-extensions: ExplicitForAll + FlexibleContexts + ScopedTypeVariables + DeriveAnyClass + DeriveGeneric StandaloneDeriving DeriveLift + GeneralizedNewtypeDeriving DeriveFunctor DeriveFoldable DeriveTraversable + MonoLocalBinds + MultiParamTypeClasses + RecordWildCards + OverloadedStrings + TypeFamilies + QuasiQuotes + TemplateHaskell + DataKinds + TypeOperators executable mlabs-plutus-use-caases main-is: Main.hs @@ -63,7 +78,6 @@ executable mlabs-plutus-use-caases -- hs-source-dirs: default-language: Haskell2010 - Test-suite mlabs-plutus-use-cases-tests Type: exitcode-stdio-1.0 Ghc-options: -Wall -threaded -rtsopts diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index db3e0af7a..1690b5510 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -1,5 +1,60 @@ module Mlabs.Lending where -import qualified PlutusTx.Prelude as Plutus +-- import qualified PlutusTx.Prelude as Plutus + +import Data.Aeson +import Data.Text (Text) +import GHC.Generics (Generic) + +import Ledger hiding (singleton) +-- import Ledger.Constraints as Constraints +-- import Ledger.Constraints.OnChain as Constraints +-- import Ledger.Constraints.TxConstraints as Constraints +import Plutus.Contract +import qualified PlutusTx +import qualified Ledger.Typed.Scripts as Scripts + + +import Playground.Contract (ToSchema) + +newtype Pool = Pool + { poolCurrency :: CurrencySymbol + } + deriving (Show) +PlutusTx.unstableMakeIsData ''Pool + +data Action + = Create Pool + | Close + deriving (Show) + +PlutusTx.unstableMakeIsData ''Action + +data LendingDatum = LendingDatum + { ldCurrency :: CurrencySymbol + } + +PlutusTx.unstableMakeIsData ''LendingDatum + +data CreateParams = CreateParams + { cpCurrency :: CurrencySymbol + } + deriving (Show, Generic, ToJSON, FromJSON, ToSchema) + +create :: HasBlockchainActions s => CreateParams -> Contract w s Text () +create _ = do + return () + +data Lending +instance Scripts.ScriptType Lending where + type RedeemerType Lending = Action + type DatumType Lending = LendingDatum + +type LendingSchema = + BlockchainActions + .\/ Endpoint "create" () + +-- endpoints :: Contract w LendingSchema Void () +-- endpoints = forever endpoints From 61759abe97740bd53a9e420f42e23b6e9dbf70e8 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 28 Apr 2021 19:35:10 +0300 Subject: [PATCH 03/81] Adds validator for create endpoint for Lending --- mlabs/.gitignore | 2 + mlabs/LICENSE | 201 +++++++++++++++++++++++++++++ mlabs/app/Main.hs | 2 + mlabs/mlabs-plutus-use-cases.cabal | 13 +- mlabs/src/Mlabs/Lending.hs | 163 ++++++++++++++++++++--- mlabs/src/Mlabs/Lending/Coin.hs | 26 ++++ mlabs/src/Mlabs/Lending/Utils.hs | 17 +++ mlabs/stack.yaml | 131 +++++++++++++++++++ 8 files changed, 531 insertions(+), 24 deletions(-) create mode 100644 mlabs/LICENSE create mode 100644 mlabs/src/Mlabs/Lending/Coin.hs create mode 100644 mlabs/src/Mlabs/Lending/Utils.hs create mode 100644 mlabs/stack.yaml diff --git a/mlabs/.gitignore b/mlabs/.gitignore index c33954f53..fa050c17c 100644 --- a/mlabs/.gitignore +++ b/mlabs/.gitignore @@ -1 +1,3 @@ dist-newstyle/ +.stack-work/ +stack.yaml.lock diff --git a/mlabs/LICENSE b/mlabs/LICENSE new file mode 100644 index 000000000..261eeb9e9 --- /dev/null +++ b/mlabs/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/mlabs/app/Main.hs b/mlabs/app/Main.hs index 65ae4a05d..a7f65cb1c 100644 --- a/mlabs/app/Main.hs +++ b/mlabs/app/Main.hs @@ -1,4 +1,6 @@ module Main where +import Prelude + main :: IO () main = putStrLn "Hello, Haskell!" diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 91fbc3061..7fd41c24a 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -2,7 +2,7 @@ cabal-version: >=1.10 -- Initial package description 'mlabs-plutus-use-cases.cabal' generated by 'cabal init'. -- For further documentation, see http://haskell.org/cabal/users-guide/ -name: mlabs-plutus-use-caases +name: mlabs-plutus-use-cases version: 0.1.0.0 -- synopsis: -- description: @@ -29,6 +29,7 @@ library , plutus-contract , plutus-ledger , plutus-tx + , plutus-ledger-api , plutus-tx-plugin , plutus-pab , prettyprinter @@ -38,15 +39,19 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: - Mlabs.Lending + Mlabs.Lending + Mlabs.Lending.Coin + Mlabs.Lending.Utils default-extensions: ExplicitForAll FlexibleContexts ScopedTypeVariables + DerivingStrategies DeriveAnyClass DeriveGeneric StandaloneDeriving DeriveLift GeneralizedNewtypeDeriving DeriveFunctor DeriveFoldable DeriveTraversable MonoLocalBinds MultiParamTypeClasses + NoImplicitPrelude RecordWildCards OverloadedStrings TypeFamilies @@ -54,10 +59,10 @@ library TemplateHaskell DataKinds TypeOperators + TypeApplications executable mlabs-plutus-use-caases - main-is: Main.hs - hs-source-dirs: app/ + main-is: app/Main.hs -- other-modules: -- other-extensions: build-depends: base >=4.14 && <4.15 diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index 1690b5510..b4061ea4e 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -1,48 +1,168 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} module Mlabs.Lending where --- import qualified PlutusTx.Prelude as Plutus +import PlutusTx.Prelude hiding (Semigroup(..), unless) +import qualified PlutusTx.Prelude as Plutus -import Data.Aeson +import Control.Monad (forever) + +import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import GHC.Generics (Generic) import Ledger hiding (singleton) -- import Ledger.Constraints as Constraints --- import Ledger.Constraints.OnChain as Constraints --- import Ledger.Constraints.TxConstraints as Constraints +import Ledger.Constraints.OnChain as Constraints +import Ledger.Constraints.TxConstraints as Constraints import Plutus.Contract import qualified PlutusTx import qualified Ledger.Typed.Scripts as Scripts - import Playground.Contract (ToSchema) +import qualified Prelude -newtype Pool = Pool - { poolCurrency :: CurrencySymbol - } - deriving (Show) -PlutusTx.unstableMakeIsData ''Pool +import Mlabs.Lending.Coin +import Mlabs.Lending.Utils +lendexTokenName, poolStateTokenName :: TokenName +lendexTokenName = "Lendex" +poolStateTokenName = "Pool State" + +newtype Lendex = Lendex + { lxCoin :: Coin + } deriving stock (Show, Generic) + deriving anyclass (ToJSON, FromJSON, ToSchema) + deriving newtype (Prelude.Eq, Prelude.Ord) +PlutusTx.makeLift ''Lendex + +-- | Available actions data Action - = Create Pool + = Create Coin | Close deriving (Show) PlutusTx.unstableMakeIsData ''Action +PlutusTx.makeLift ''Action -data LendingDatum = LendingDatum - { ldCurrency :: CurrencySymbol - } +type LendingPool = [Coin] + +-- | Lending datum +data LendingDatum + = Factory [Coin] + | Pool Coin PlutusTx.unstableMakeIsData ''LendingDatum +PlutusTx.makeLift ''LendingDatum +-- | Parameters for create endpoint data CreateParams = CreateParams - { cpCurrency :: CurrencySymbol + { cpCoin :: Coin } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) -create :: HasBlockchainActions s => CreateParams -> Contract w s Text () -create _ = do +{-# INLINABLE mkValidator #-} +-- | On-chain script validator +mkValidator :: Lendex -> Coin -> LendingDatum -> Action -> ScriptContext -> Bool +mkValidator lx c dat act ctx = case (dat, act) of + (Factory cs, Create pool) -> validateCreate lx c cs pool ctx + (_, Close ) -> validateClose lx c dat ctx + _ -> False + +{-# INLINABLE validateCreate #-} +-- | Validate create-case +validateCreate :: Lendex -> Coin -> [Coin] -> Coin -> ScriptContext -> Bool +validateCreate Lendex{..} poolCoin coins newCoin ctx = + lendexCoinPresent + && newCoinIsAdded + && poolStateCoinForged + && keepsLedexCoin + && keepsPoolStateCoin + where + lendexCoinPresent = + Plutus.traceIfFalse "Lendex coin not present" + (coinValueOf (valueWithin $ findOwnInput' ctx) lxCoin == 1) + + newCoinIsAdded = + Plutus.traceIfFalse "New coin is added to pool" $ + all (/= newCoin) coins + + poolStateCoinForged = + Plutus.traceIfFalse "Pool state coin not forged" $ + (coinValueOf forged poolCoin == 1) + + keepsLedexCoin = + Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ newCoin : coins) $ + coin lxCoin 1) + + keepsPoolStateCoin = + Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Pool newCoin) $ + coin poolCoin 1) + + forged :: Value + forged = txInfoForge $ scriptContextTxInfo ctx + +{-# INLINABLE validateClose #-} +validateClose :: Lendex -> Coin -> LendingDatum -> ScriptContext -> Bool +validateClose _ _ _ _ = True + +{-# INLINABLE validateLiquidityForging #-} +validateLiquidityForging :: Lendex -> TokenName -> ScriptContext -> Bool +validateLiquidityForging us tn ctx = case [ i + | i <- txInfoInputs $ scriptContextTxInfo ctx + , let v = valueWithin i + , (coinValueOf v usC == 1) || + (coinValueOf v lpC == 1) + ] of + [_] -> True + [_, _] -> True + _ -> Plutus.traceError "pool state forging without Lendex input" + where + usC, lpC :: Coin + usC = lxCoin us + lpC = mkCoin (ownCurrencySymbol ctx) tn + +lendexInstance :: Lendex -> Scripts.ScriptInstance Lending +lendexInstance lx = Scripts.validator @Lending + ($$(PlutusTx.compile [|| mkValidator ||]) + `PlutusTx.applyCode` PlutusTx.liftCode lx + `PlutusTx.applyCode` PlutusTx.liftCode c) + $$(PlutusTx.compile [|| wrap ||]) + where + c :: Coin + c = poolStateCoin lx + + wrap = Scripts.wrapValidator @LendingDatum @Action + +lendexScript :: Lendex -> Validator +lendexScript = Scripts.validatorScript . lendexInstance + +lendexAddress :: Lendex -> Ledger.Address +lendexAddress = Ledger.scriptAddress . lendexScript + +lendex :: CurrencySymbol -> Lendex +lendex cs = Lendex $ mkCoin cs lendexTokenName + +poolStateCoin :: Lendex -> Coin +poolStateCoin = flip mkCoin poolStateTokenName . liquidityCurrency + +liquidityPolicy :: Lendex -> MonetaryPolicy +liquidityPolicy lx = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) + `PlutusTx.applyCode` PlutusTx.liftCode lx + `PlutusTx.applyCode` PlutusTx.liftCode poolStateTokenName + +liquidityCurrency :: Lendex -> CurrencySymbol +liquidityCurrency = scriptCurrencySymbol . liquidityPolicy + +findLendingFactory :: App (TxOutRef, TxOut, LendingPool) +findLendingFactory = undefined + +-- | TODO +create :: CreateParams -> App () +create CreateParams{..} = do + (_oref, _outp, _lps) <- findLendingFactory + let _usDat = cpCoin return () data Lending @@ -52,9 +172,12 @@ instance Scripts.ScriptType Lending where type LendingSchema = BlockchainActions - .\/ Endpoint "create" () + .\/ Endpoint "create" CreateParams --- endpoints :: Contract w LendingSchema Void () --- endpoints = forever endpoints +type App a = Contract () LendingSchema Text a +endpoints :: App () +endpoints = create' >> forever endpoints + where + create' = endpoint @"create" >>= create diff --git a/mlabs/src/Mlabs/Lending/Coin.hs b/mlabs/src/Mlabs/Lending/Coin.hs new file mode 100644 index 000000000..c97c1e78d --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Coin.hs @@ -0,0 +1,26 @@ +{-# options_ghc -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-specialize #-} +module Mlabs.Lending.Coin where + +import PlutusTx.Prelude (Integer) + +import Ledger hiding (singleton) +import Ledger.Value (AssetClass (..), assetClassValue, assetClassValueOf, assetClass) +import Playground.Contract (ToSchema) + +type Coin = AssetClass +deriving anyclass instance ToSchema AssetClass + +{-# INLINABLE coin #-} +coin :: AssetClass -> Integer -> Value +coin = assetClassValue + +{-# INLINABLE coinValueOf #-} +coinValueOf :: Value -> AssetClass -> Integer +coinValueOf = assetClassValueOf + +{-# INLINABLE mkCoin #-} +mkCoin:: CurrencySymbol -> TokenName -> AssetClass +mkCoin = assetClass + diff --git a/mlabs/src/Mlabs/Lending/Utils.hs b/mlabs/src/Mlabs/Lending/Utils.hs new file mode 100644 index 000000000..fed9b9d10 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Utils.hs @@ -0,0 +1,17 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-specialize #-} +module Mlabs.Lending.Utils where + +import PlutusTx.Prelude ((.), error) +import qualified PlutusTx.Prelude as Plutus +import Ledger hiding (singleton) + +{-# INLINABLE valueWithin #-} +valueWithin :: TxInInfo -> Value +valueWithin = txOutValue . txInInfoResolved + +{-# INLINABLE findOwnInput' #-} +findOwnInput' :: ScriptContext -> TxInInfo +findOwnInput' ctx = Plutus.fromMaybe (error ()) (findOwnInput ctx) + + diff --git a/mlabs/stack.yaml b/mlabs/stack.yaml new file mode 100644 index 000000000..54531da22 --- /dev/null +++ b/mlabs/stack.yaml @@ -0,0 +1,131 @@ +resolver: lts-17.2 + +nix: + packages: + - cacert # Fixes "SSL certificate problem: unable to get local issuer certificate" + - zlib + +packages: +- . + +extra-deps: +- git: https://github.com/input-output-hk/plutus.git + commit: 62be7a2d6dff285ad72d5bc6f5f11991ffae888b + subdirs: + - playground-common + - plutus-core + - plutus-contract + - plutus-ledger + - plutus-tx + - plutus-tx-plugin + - prettyprinter-configurable + - plutus-ledger-api + - plutus-pab + - plutus-use-cases + - freer-extras + - quickcheck-dynamic +# Flat compression +- pure-zlib-0.6.7@sha256:5a1cdf87bf3079b7d3abace1f94eeb3c597c687a38a08ee2908783e609271467,3487 +# FEAT/NEAT and deps +- lazy-search-0.1.2.0 +- size-based-0.1.2.0 +- testing-feat-1.1.0.0 +- Stream-0.4.7.2@sha256:ed78165aa34c4e23dc53c9072f8715d414a585037f2145ea0eb2b38300354c53,1009 +- lazysmallcheck-0.6@sha256:dac7a1e4877681f1260309e863e896674dd6efc1159897b7945893e693f2a6bc,1696 +# Other missing packages +- aws-lambda-haskell-runtime-3.0.3 +- aws-lambda-haskell-runtime-wai-1.0.2@sha256:5ce655247461b562c8048011ddc022130135a03417def8203aad92366cc979ab,1965 +- composition-prelude-3.0.0.2 +- constraints-extras-0.3.0.2 +- dependent-map-0.4.0.0 +- dependent-sum-0.6.2.0 +- dependent-sum-template-0.1.0.3 +- eventful-memory-0.2.0 +- barbies-2.0.2.0 +- nothunks-0.1.2 +- indexed-traversable-instances-0.1 +- base16-bytestring-1.0.1.0 +# A revision was added to keep the bounds down, we don't actually want this! +# we work around the newer persistent-template by adding flags below +- eventful-sql-common-0.2.0@rev:0 +- eventful-sqlite-0.2.0 +- monoidal-containers-0.6.0.1 +- recursion-schemes-5.1.3 +- row-types-0.4.0.0 +- time-out-0.2@sha256:b9a6b4dee64f030ecb2a25dca0faff39b3cb3b5fefbb8af3cdec4142bfd291f2 +- time-interval-0.1.1@sha256:7bfd3601853d1af7caa18248ec10b01701d035ac274a93bb4670fea52a14d4e8 +- time-units-1.0.0@sha256:27cf54091c4a0ca73d504fc11d5c31ab4041d17404fe3499945e2055697746c1 +- servant-websockets-2.0.0 +- servant-subscriber-0.7.0.0 +- safe-exceptions-checked-0.1.0 +- async-timer-0.1.4.1 +- sbv-8.9 +- wl-pprint-1.2.1@sha256:aea676cff4a062d7d912149d270e33f5bb0c01b68a9db46ff13b438141ff4b7c +- witherable-0.4.1 +- canonical-json-0.6.0.0@sha256:9021f435ccb884a3b4c55bcc6b50eb19d5fc3cc3f29d5fcbdef016f5bbae23a2,3488 +- statistics-linreg-0.3@sha256:95c6efe6c7f6b26bc6e9ada90ab2d18216371cf59a6ef2b517b4a6fd35d9a76f,2544 +# cabal.project is the source of truth for these pins, they are explained there +# and need to be kept in sync. +- git: https://github.com/shmish111/purescript-bridge.git + commit: 6a92d7853ea514be8b70bab5e72077bf5a510596 +- git: https://github.com/eskimor/servant-purescript.git + commit: 6454d5bcb9aa2a5d6e3a3dc935423b67b6f3993c +- git: https://github.com/input-output-hk/cardano-crypto.git + commit: f73079303f663e028288f9f4a9e08bcca39a923e +- git: https://github.com/michaelpj/unlit.git + commit: 9ca1112093c5ffd356fc99c7dafa080e686dd748 +- git: https://github.com/input-output-hk/ouroboros-network + commit: 6cb9052bde39472a0555d19ade8a42da63d3e904 + subdirs: + - typed-protocols + - typed-protocols-examples + - ouroboros-network + - ouroboros-network-framework + - io-sim + - io-sim-classes + - network-mux + - Win32-network +- git: https://github.com/input-output-hk/cardano-prelude + commit: ee4e7b547a991876e6b05ba542f4e62909f4a571 + subdirs: + - cardano-prelude + - cardano-prelude-test +- git: https://github.com/input-output-hk/cardano-base + commit: 4251c0bb6e4f443f00231d28f5f70d42876da055 + subdirs: + - binary + - cardano-crypto-class + - cardano-crypto-tests + - cardano-crypto-praos + - slotting +- git: https://github.com/input-output-hk/cardano-ledger-specs + commit: 097890495cbb0e8b62106bcd090a5721c3f4b36f + subdirs: + - 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 +- git: https://github.com/input-output-hk/iohk-monitoring-framework + commit: a89c38ed5825ba17ca79fddb85651007753d699d + subdirs: + - contra-tracer + - iohk-monitoring + - tracer-transformers + - plugins/backend-ekg +allow-newer: true + +extra-package-dbs: [] + + + +ghc-options: + # Newer versions of persistent-template require some extra language extensions. Fortunately + # we can hack around this here rather than having to fork eventful & co (for now) + eventful-sql-common: "-XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances -XMultiParamTypeClasses" From 7cc8065603933b525281341694ee79e390563c16 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 29 Apr 2021 15:51:35 +0300 Subject: [PATCH 04/81] Mv to stack. Finish Lendex.create endpoint stub --- mlabs/Makefile | 16 ++--- mlabs/mlabs-plutus-use-cases.cabal | 1 + mlabs/src/Mlabs/Lending.hs | 99 ++++++++++++++++++++++-------- mlabs/src/Mlabs/Lending/Coin.hs | 7 ++- 4 files changed, 89 insertions(+), 34 deletions(-) diff --git a/mlabs/Makefile b/mlabs/Makefile index bdd0712c0..9ae6f7c82 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -2,17 +2,17 @@ hoogle: requires_nix_shell hoogle server --local --port 8008 -build: requires_nix_shell - cabal build all +build: + stack build --ghc-options="-Wall" -repl: requires_nix_shell - cabal new-repl +repl: + stack ghci -test: requires_nix_shell - cabal test all +test: + stack test all -watch: requires_nix_shell - ghcid "-c cabal new-repl" +watch: + stack build --file-watch --ghc-options="-Wall" # Target to use as dependency to fail if not inside nix-shell requires_nix_shell: diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 7fd41c24a..9a40d8db2 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -49,6 +49,7 @@ library DeriveAnyClass DeriveGeneric StandaloneDeriving DeriveLift GeneralizedNewtypeDeriving DeriveFunctor DeriveFoldable DeriveTraversable + LambdaCase MonoLocalBinds MultiParamTypeClasses NoImplicitPrelude diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index b4061ea4e..023759455 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -5,14 +5,14 @@ module Mlabs.Lending where import PlutusTx.Prelude hiding (Semigroup(..), unless) import qualified PlutusTx.Prelude as Plutus -import Control.Monad (forever) +import Control.Monad (forever, void) import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import GHC.Generics (Generic) import Ledger hiding (singleton) --- import Ledger.Constraints as Constraints +import Ledger.Constraints as Constraints import Ledger.Constraints.OnChain as Constraints import Ledger.Constraints.TxConstraints as Constraints import Plutus.Contract @@ -21,6 +21,9 @@ import qualified Ledger.Typed.Scripts as Scripts import Playground.Contract (ToSchema) import qualified Prelude +import Prelude (Semigroup(..)) +import qualified Data.Map as Map +import Text.Printf (printf) import Mlabs.Lending.Coin import Mlabs.Lending.Utils @@ -51,6 +54,7 @@ type LendingPool = [Coin] data LendingDatum = Factory [Coin] | Pool Coin + deriving stock Show PlutusTx.unstableMakeIsData ''LendingDatum PlutusTx.makeLift ''LendingDatum @@ -80,8 +84,8 @@ validateCreate Lendex{..} poolCoin coins newCoin ctx = && keepsPoolStateCoin where lendexCoinPresent = - Plutus.traceIfFalse "Lendex coin not present" - (coinValueOf (valueWithin $ findOwnInput' ctx) lxCoin == 1) + Plutus.traceIfFalse "Lendex coin not present" $ + hasCoinValue (valueWithin $ findOwnInput' ctx) lxCoin newCoinIsAdded = Plutus.traceIfFalse "New coin is added to pool" $ @@ -89,15 +93,12 @@ validateCreate Lendex{..} poolCoin coins newCoin ctx = poolStateCoinForged = Plutus.traceIfFalse "Pool state coin not forged" $ - (coinValueOf forged poolCoin == 1) + hasCoinValue forged poolCoin - keepsLedexCoin = - Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Factory $ newCoin : coins) $ - coin lxCoin 1) + keepsLedexCoin = keepsCoin (Factory $ newCoin : coins) lxCoin + keepsPoolStateCoin = keepsCoin (Pool newCoin) poolCoin - keepsPoolStateCoin = - Constraints.checkOwnOutputConstraint ctx (OutputConstraint (Pool newCoin) $ - coin poolCoin 1) + keepsCoin st c = Constraints.checkOwnOutputConstraint ctx (OutputConstraint st $ coin c 1) forged :: Value forged = txInfoForge $ scriptContextTxInfo ctx @@ -111,8 +112,8 @@ validateLiquidityForging :: Lendex -> TokenName -> ScriptContext -> Bool validateLiquidityForging us tn ctx = case [ i | i <- txInfoInputs $ scriptContextTxInfo ctx , let v = valueWithin i - , (coinValueOf v usC == 1) || - (coinValueOf v lpC == 1) + , hasCoinValue v usC || + hasCoinValue v lpC ] of [_] -> True [_, _] -> True @@ -155,15 +156,63 @@ liquidityPolicy lx = mkMonetaryPolicyScript $ liquidityCurrency :: Lendex -> CurrencySymbol liquidityCurrency = scriptCurrencySymbol . liquidityPolicy -findLendingFactory :: App (TxOutRef, TxOut, LendingPool) -findLendingFactory = undefined - --- | TODO -create :: CreateParams -> App () -create CreateParams{..} = do - (_oref, _outp, _lps) <- findLendingFactory - let _usDat = cpCoin - return () +findLendexInstance :: Lendex -> Coin -> (LendingDatum -> Maybe a) -> App (TxOutRef, TxOutTx, a) +findLendexInstance us c f = do + let addr = lendexAddress us + logInfo @String $ printf "looking for Lendex instance at address %s containing coin %s " (show addr) (show c) + utxos <- utxoAt addr + go [x | x@(_, o) <- Map.toList utxos, coinValueOf (txOutValue $ txOutTxOut o) c == 1] + where + go [] = throwError "Lendex instance not found" + go ((oref, o) : xs) = do + d <- getLendexDatum o + case f d of + Nothing -> go xs + Just a -> do + logInfo @String $ printf "found Lendex instance with datum: %s" (show d) + return (oref, o, a) + +findLendexFactory :: Lendex -> App (TxOutRef, TxOutTx, [Coin]) +findLendexFactory lx@Lendex{..} = findLendexInstance lx lxCoin $ \case + Factory lps -> Just lps + Pool _ -> Nothing + +getLendexDatum :: TxOutTx -> App LendingDatum +getLendexDatum 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 + +-- | Creates a liquidity pool for a given coin. +create :: Lendex -> CreateParams -> App () +create lx CreateParams{..} = do + (oref, o, lps) <- findLendexFactory lx + let lp = cpCoin + usInst = lendexInstance lx + usScript = lendexScript lx + usDat1 = Factory $ lp : lps + usDat2 = Pool lp + psC = poolStateCoin lx + usVal = coin (lxCoin lx) 1 + lpVal = coin cpCoin 0 + + lookups = Constraints.scriptInstanceLookups usInst + <> Constraints.otherScript usScript + <> Constraints.monetaryPolicy (liquidityPolicy lx) + <> Constraints.unspentOutputs (Map.singleton oref o) + + tx = Constraints.mustPayToTheScript usDat1 usVal + <> Constraints.mustPayToTheScript usDat2 lpVal + <> Constraints.mustForgeValue (coin psC 1) + <> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData $ Create lp) + + ledgerTx <- submitTxConstraintsWith lookups tx + void $ awaitTxConfirmed $ txId ledgerTx + + logInfo $ "created liquidity pool: " ++ show lp data Lending instance Scripts.ScriptType Lending where @@ -176,8 +225,8 @@ type LendingSchema = type App a = Contract () LendingSchema Text a -endpoints :: App () -endpoints = create' >> forever endpoints +userEndpoints :: Lendex -> App () +userEndpoints lx = forever create' where - create' = endpoint @"create" >>= create + create' = endpoint @"create" >>= create lx diff --git a/mlabs/src/Mlabs/Lending/Coin.hs b/mlabs/src/Mlabs/Lending/Coin.hs index c97c1e78d..6ef15781d 100644 --- a/mlabs/src/Mlabs/Lending/Coin.hs +++ b/mlabs/src/Mlabs/Lending/Coin.hs @@ -3,7 +3,7 @@ {-# OPTIONS_GHC -fno-specialize #-} module Mlabs.Lending.Coin where -import PlutusTx.Prelude (Integer) +import PlutusTx.Prelude (Integer, Bool, Eq(..)) import Ledger hiding (singleton) import Ledger.Value (AssetClass (..), assetClassValue, assetClassValueOf, assetClass) @@ -24,3 +24,8 @@ coinValueOf = assetClassValueOf mkCoin:: CurrencySymbol -> TokenName -> AssetClass mkCoin = assetClass +{-# INLINABLE hasCoinValue #-} +-- | We check that value for coin is present and equals to 1. +-- It serves as a marker of coin presence. +hasCoinValue :: Value -> Coin -> Bool +hasCoinValue val c = coinValueOf val c == 1 From 0720f497766e0dea243a51ee1b9e7ef73f0d2233 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 29 Apr 2021 18:57:07 +0300 Subject: [PATCH 05/81] Defines test case for create of pool --- mlabs/mlabs-plutus-use-cases.cabal | 15 +++++- mlabs/src/Mlabs/Lending.hs | 56 +++++++++++++++++++- mlabs/test/Main.hs | 6 ++- mlabs/test/Test/Lending.hs | 85 ++++++++++++++++++++++++++++-- 4 files changed, 156 insertions(+), 6 deletions(-) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 9a40d8db2..d7ca1c821 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -32,6 +32,7 @@ library , plutus-ledger-api , plutus-tx-plugin , plutus-pab + , plutus-use-cases , prettyprinter , lens , text @@ -90,9 +91,21 @@ Test-suite mlabs-plutus-use-cases-tests Default-Language: Haskell2010 Build-Depends: base >=4.9 && <5 , mlabs-plutus-use-cases - , text + , containers + , playground-common + , plutus-core + , plutus-contract + , plutus-ledger + , plutus-tx + , plutus-ledger-api + , plutus-tx-plugin + , plutus-pab + , plutus-use-cases + , plutus-contract + , prettyprinter , tasty , tasty-hunit + , text hs-source-dirs: test Main-is: Main.hs Other-modules: Test.Lending diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index 023759455..a54edf5db 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -7,15 +7,20 @@ import qualified PlutusTx.Prelude as Plutus import Control.Monad (forever, void) +import Data.Monoid (Last(..)) +import Data.Void (Void) + import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import GHC.Generics (Generic) + import Ledger hiding (singleton) import Ledger.Constraints as Constraints import Ledger.Constraints.OnChain as Constraints import Ledger.Constraints.TxConstraints as Constraints import Plutus.Contract +import qualified Plutus.Contracts.Currency as Currency import qualified PlutusTx import qualified Ledger.Typed.Scripts as Scripts @@ -24,10 +29,14 @@ import qualified Prelude import Prelude (Semigroup(..)) import qualified Data.Map as Map import Text.Printf (printf) - +import qualified Plutus.Trace as Trace +import Plutus.Contract.Trace (Wallet) +import Plutus.Trace (EmulatorTrace) import Mlabs.Lending.Coin import Mlabs.Lending.Utils +import qualified Data.Text as T + lendexTokenName, poolStateTokenName :: TokenName lendexTokenName = "Lendex" poolStateTokenName = "Pool State" @@ -186,6 +195,25 @@ getLendexDatum o = case txOutDatumHash $ txOutTxOut o of Nothing -> throwError "datum has wrong type" Just d -> return d +-- | Creates a Lendex "factory". This factory will keep track of the existing +-- liquidity pools and enforce that there will be at most one liquidity pool +-- for any pair of tokens at any given time. +start :: HasBlockchainActions s => Contract w s Text Lendex +start = do + pkh <- pubKeyHash <$> ownPubKey + cs <- fmap Currency.currencySymbol $ + mapError (T.pack . show @Currency.CurrencyError) $ + Currency.forgeContract pkh [(lendexTokenName, 1)] + let c = mkCoin cs lendexTokenName + us = lendex cs + inst = lendexInstance us + tx = mustPayToTheScript (Factory []) $ coin c 1 + ledgerTx <- submitTxConstraints inst tx + void $ awaitTxConfirmed $ txId ledgerTx + + logInfo @String $ printf "started Uniswap %s at address %s" (show us) (show $ lendexAddress us) + return us + -- | Creates a liquidity pool for a given coin. create :: Lendex -> CreateParams -> App () create lx CreateParams{..} = do @@ -219,14 +247,40 @@ instance Scripts.ScriptType Lending where type RedeemerType Lending = Action type DatumType Lending = LendingDatum +type LendingOwnerSchema = + BlockchainActions + .\/ Endpoint "start" () + type LendingSchema = BlockchainActions .\/ Endpoint "create" CreateParams type App a = Contract () LendingSchema Text a +type OwnerApp a = Contract () LendingOwnerSchema Text a + +ownerEndpoint :: Contract (Last Lendex) BlockchainActions Void () +ownerEndpoint = do + e <- runError start + tell $ Last $ case e of + Left _err -> Nothing + Right lx -> Just lx userEndpoints :: Lendex -> App () userEndpoints lx = forever create' where create' = endpoint @"create" >>= create lx +----------------------------------------------- +-- call endpoints (for testing) + +callStart :: Wallet -> EmulatorTrace (Maybe Lendex) +callStart w = do + hdl <- Trace.activateContractWallet w ownerEndpoint + Last res <- Trace.observableState hdl + return res + +callCreate :: Lendex ->Wallet -> CreateParams -> EmulatorTrace () +callCreate lx w cp = do + hdl <- Trace.activateContractWallet w (userEndpoints lx) + void $ Trace.callEndpoint @"create" hdl cp + diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index d82a4bd93..de8687357 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -1,4 +1,8 @@ module Main where +import Test.Tasty +import qualified Test.Lending as Lending + main :: IO () -main = return () +main = defaultMain Lending.tests + diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs index 7af7be059..a7e4a9abe 100644 --- a/mlabs/test/Test/Lending.hs +++ b/mlabs/test/Test/Lending.hs @@ -1,7 +1,86 @@ module Test.Lending( - test + tests ) where -test :: Bool -test = True + +import Test.Tasty +import Test.Tasty.HUnit + +import Prelude (($), Maybe(..), Bool(..)) +import Data.Either +import Data.Maybe (isNothing) + +import Control.Monad (void) +import qualified Plutus.V1.Ledger.Ada as Ada +import qualified Plutus.V1.Ledger.Value as Ledger +import qualified Data.Map as M +import qualified PlutusTx.AssocMap as PM + +-------------------------------------------------------------------------------- + +import Plutus.Contract.Test hiding (tx) +import qualified Plutus.Trace.Emulator as Trace + +import qualified Mlabs.Lending as L +import qualified Mlabs.Lending.Coin as L + +tests :: TestTree +tests = testGroup "Lending" + [ testCreate + ] + +testCreate :: TestTree +testCreate = testCase "Create lending pool" $ assertBool "script runs with no errors" $ + testOk initConfig createScript + +------------------------------------------------------------------------------------ + +currency :: Ledger.CurrencySymbol +currency = Ledger.currencySymbol "T" + +token :: Ledger.TokenName +token = Ledger.tokenName "token" + +createScript :: Trace.EmulatorTrace () +createScript = do + mTheLendex <- L.callStart w1 + next + case mTheLendex of + Just theLendex -> do + L.callCreate theLendex w1 $ L.CreateParams + { cpCoin = L.mkCoin currency token + } + next + Nothing -> Trace.throwError (Trace.GenericError "No lendex was created") + where + next = void Trace.nextSlot + +testOk :: Trace.EmulatorConfig -> Trace.EmulatorTrace () -> Bool +testOk cfg trace = isNothing $ (\(_, merr, _) -> merr) $ Trace.runEmulatorTrace cfg trace + +------------------------------------------------------------------------------------ +-- init blockchain state + +w1, w2, w3, w4 :: Wallet +w1 = Wallet 1 +w2 = Wallet 2 +w3 = Wallet 3 +w4 = Wallet 4 + +initConfig :: Trace.EmulatorConfig +initConfig = cfg + where + cfg = Trace.EmulatorConfig $ Left $ M.fromList + [ (w1, v1) + , (w2, v2) + , (w3, v2) + , (w4, v2) + ] + + v1 = val 1000 10 + v2 = val 1000 0 + + val x y = Ledger.Value $ PM.fromList + [ (Ada.adaSymbol, PM.singleton Ada.adaToken x) + , (currency, PM.singleton token y)] From 0295145196f872a6f1f14c60ac82a8e206613788 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 29 Apr 2021 19:06:33 +0300 Subject: [PATCH 06/81] remove redundant imports --- mlabs/test/Test/Lending.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs index a7e4a9abe..f7bea35e9 100644 --- a/mlabs/test/Test/Lending.hs +++ b/mlabs/test/Test/Lending.hs @@ -6,7 +6,7 @@ module Test.Lending( import Test.Tasty import Test.Tasty.HUnit -import Prelude (($), Maybe(..), Bool(..)) +import Prelude (($), Maybe(..), Bool(..), String) import Data.Either import Data.Maybe (isNothing) @@ -51,7 +51,7 @@ createScript = do { cpCoin = L.mkCoin currency token } next - Nothing -> Trace.throwError (Trace.GenericError "No lendex was created") + Nothing -> throwError "No lendex was created" where next = void Trace.nextSlot @@ -84,3 +84,9 @@ initConfig = cfg [ (Ada.adaSymbol, PM.singleton Ada.adaToken x) , (currency, PM.singleton token y)] +------------------------------------------------------------------------------------ +-- utils + +throwError :: String -> Trace.EmulatorTrace a +throwError msg = Trace.throwError (Trace.GenericError msg) + From 497edb9b61e92433d51d58ce380a88f2c02a3fe5 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 30 Apr 2021 17:01:49 +0300 Subject: [PATCH 07/81] Fix creation tests --- mlabs/src/Mlabs/Lending.hs | 14 ++++++++++++-- mlabs/test/Test/Lending.hs | 24 +++++++++++++++--------- 2 files changed, 27 insertions(+), 11 deletions(-) diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index a54edf5db..331c23315 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -258,13 +258,21 @@ type LendingSchema = type App a = Contract () LendingSchema Text a type OwnerApp a = Contract () LendingOwnerSchema Text a -ownerEndpoint :: Contract (Last Lendex) BlockchainActions Void () -ownerEndpoint = do +ownerEndpoint' :: Contract (Last Lendex) BlockchainActions Void () +ownerEndpoint' = do e <- runError start tell $ Last $ case e of Left _err -> Nothing Right lx -> Just lx +ownerEndpoint :: Contract (Last Lendex) LendingOwnerSchema Text () +ownerEndpoint = forever start' + where + start' = + endpoint @"start" >>= \() -> do + lx <- start + tell $ Last $ Just lx + userEndpoints :: Lendex -> App () userEndpoints lx = forever create' where @@ -276,6 +284,8 @@ userEndpoints lx = forever create' callStart :: Wallet -> EmulatorTrace (Maybe Lendex) callStart w = do hdl <- Trace.activateContractWallet w ownerEndpoint + void $ Trace.callEndpoint @"start" hdl () + void $ Trace.waitNSlots 10 Last res <- Trace.observableState hdl return res diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs index f7bea35e9..49bcf062e 100644 --- a/mlabs/test/Test/Lending.hs +++ b/mlabs/test/Test/Lending.hs @@ -2,13 +2,11 @@ module Test.Lending( tests ) where +import Prelude import Test.Tasty import Test.Tasty.HUnit -import Prelude (($), Maybe(..), Bool(..), String) -import Data.Either -import Data.Maybe (isNothing) import Control.Monad (void) import qualified Plutus.V1.Ledger.Ada as Ada @@ -30,8 +28,7 @@ tests = testGroup "Lending" ] testCreate :: TestTree -testCreate = testCase "Create lending pool" $ assertBool "script runs with no errors" $ - testOk initConfig createScript +testCreate = testCase "Create lending pool" $ testOk initConfig createScript ------------------------------------------------------------------------------------ @@ -52,11 +49,14 @@ createScript = do } next Nothing -> throwError "No lendex was created" - where - next = void Trace.nextSlot -testOk :: Trace.EmulatorConfig -> Trace.EmulatorTrace () -> Bool -testOk cfg trace = isNothing $ (\(_, merr, _) -> merr) $ Trace.runEmulatorTrace cfg trace + +testOk :: Trace.EmulatorConfig -> Trace.EmulatorTrace () -> IO () +testOk cfg trace = case err of + Just e -> assertFailure $ show e + Nothing -> pure () + where + err = (\(_, merr, _) -> merr) $ Trace.runEmulatorTrace cfg trace ------------------------------------------------------------------------------------ -- init blockchain state @@ -90,3 +90,9 @@ initConfig = cfg throwError :: String -> Trace.EmulatorTrace a throwError msg = Trace.throwError (Trace.GenericError msg) +next :: Trace.EmulatorTrace () +next = void Trace.nextSlot + +wait :: Integer -> Trace.EmulatorTrace () +wait = void . Trace.waitNSlots . fromInteger + From 77c1cf6b0fccd63299bafba1862587f9aba86d2c Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 3 May 2021 11:31:33 +0300 Subject: [PATCH 08/81] Adds comments. Minor refactoring --- mlabs/mlabs-plutus-use-cases.cabal | 1 + mlabs/src/Mlabs/Lending.hs | 58 ++++++++++++++++++++++++------ mlabs/test/Test/Lending.hs | 55 +++++++++------------------- mlabs/test/Test/Utils.hs | 32 +++++++++++++++++ 4 files changed, 96 insertions(+), 50 deletions(-) create mode 100644 mlabs/test/Test/Utils.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index d7ca1c821..5b0eb0bc2 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -109,6 +109,7 @@ Test-suite mlabs-plutus-use-cases-tests hs-source-dirs: test Main-is: Main.hs Other-modules: Test.Lending + , Test.Utils default-extensions: RecordWildCards OverloadedStrings diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index 331c23315..fb9599184 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -1,5 +1,15 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} +-- | Lending exchange platform (Lendex for short) is a tool for +-- user to provide lending funds. +-- +-- There are three roles of users: +-- +-- * **admin** - can initialise whole platform and close it. +-- +-- * **lender user** can create new tokens on the platform and provide funds with it. +-- +-- * **borrower user** can borrow funds. module Mlabs.Lending where import PlutusTx.Prelude hiding (Semigroup(..), unless) @@ -8,7 +18,6 @@ import qualified PlutusTx.Prelude as Plutus import Control.Monad (forever, void) import Data.Monoid (Last(..)) -import Data.Void (Void) import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) @@ -37,7 +46,9 @@ import Mlabs.Lending.Utils import qualified Data.Text as T +-- | Constants for thread of lendex state and pool state. lendexTokenName, poolStateTokenName :: TokenName + lendexTokenName = "Lendex" poolStateTokenName = "Pool State" @@ -51,7 +62,9 @@ PlutusTx.makeLift ''Lendex -- | Available actions data Action = Create Coin + -- ^ Create new coin for lending | Close + -- $ close the exchange deriving (Show) PlutusTx.unstableMakeIsData ''Action @@ -62,7 +75,11 @@ type LendingPool = [Coin] -- | Lending datum data LendingDatum = Factory [Coin] + -- ^ Global state to watch for coins that were created. + -- For every new coin we check against this state + -- weather it is new and have not been already created. | Pool Coin + -- ^ single coint to lend funds. deriving stock Show PlutusTx.unstableMakeIsData ''LendingDatum @@ -71,6 +88,7 @@ PlutusTx.makeLift ''LendingDatum -- | Parameters for create endpoint data CreateParams = CreateParams { cpCoin :: Coin + -- ^ coin for which we create lending capabilities. } deriving (Show, Generic, ToJSON, FromJSON, ToSchema) @@ -83,7 +101,7 @@ mkValidator lx c dat act ctx = case (dat, act) of _ -> False {-# INLINABLE validateCreate #-} --- | Validate create-case +-- | It validates create-case validateCreate :: Lendex -> Coin -> [Coin] -> Coin -> ScriptContext -> Bool validateCreate Lendex{..} poolCoin coins newCoin ctx = lendexCoinPresent @@ -113,10 +131,12 @@ validateCreate Lendex{..} poolCoin coins newCoin ctx = forged = txInfoForge $ scriptContextTxInfo ctx {-# INLINABLE validateClose #-} +-- | It validates the closing of the whole lending system validateClose :: Lendex -> Coin -> LendingDatum -> ScriptContext -> Bool validateClose _ _ _ _ = True {-# INLINABLE validateLiquidityForging #-} +-- | It validates the forging of new coin for lending purposes validateLiquidityForging :: Lendex -> TokenName -> ScriptContext -> Bool validateLiquidityForging us tn ctx = case [ i | i <- txInfoInputs $ scriptContextTxInfo ctx @@ -132,6 +152,7 @@ validateLiquidityForging us tn ctx = case [ i usC = lxCoin us lpC = mkCoin (ownCurrencySymbol ctx) tn +-- | Instance of validation script for lending exchange lendexInstance :: Lendex -> Scripts.ScriptInstance Lending lendexInstance lx = Scripts.validator @Lending ($$(PlutusTx.compile [|| mkValidator ||]) @@ -144,27 +165,36 @@ lendexInstance lx = Scripts.validator @Lending wrap = Scripts.wrapValidator @LendingDatum @Action +-- | Validator lendexScript :: Lendex -> Validator lendexScript = Scripts.validatorScript . lendexInstance +-- | Validator script address lendexAddress :: Lendex -> Ledger.Address lendexAddress = Ledger.scriptAddress . lendexScript +-- | Wrapper to create lendex state coin out of @CurrencySymbol@. lendex :: CurrencySymbol -> Lendex lendex cs = Lendex $ mkCoin cs lendexTokenName +-- | Constructor for pool state coin. +-- It relies on script for new coin forgery validation. poolStateCoin :: Lendex -> Coin poolStateCoin = flip mkCoin poolStateTokenName . liquidityCurrency +-- | pool state forgery validator liquidityPolicy :: Lendex -> MonetaryPolicy liquidityPolicy lx = mkMonetaryPolicyScript $ $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) `PlutusTx.applyCode` PlutusTx.liftCode lx `PlutusTx.applyCode` PlutusTx.liftCode poolStateTokenName +-- | @CurrencySumbol@ for the lendex. We use it for pool state. +-- They share common @CurrencySymbol@ liquidityCurrency :: Lendex -> CurrencySymbol liquidityCurrency = scriptCurrencySymbol . liquidityPolicy +-- | Provides TxOut that contains lendex script. findLendexInstance :: Lendex -> Coin -> (LendingDatum -> Maybe a) -> App (TxOutRef, TxOutTx, a) findLendexInstance us c f = do let addr = lendexAddress us @@ -181,11 +211,14 @@ findLendexInstance us c f = do logInfo @String $ printf "found Lendex instance with datum: %s" (show d) return (oref, o, a) +-- | Provides TXOut that contains global state of lendex. +-- It provides the list of coins that are part of the exchange so far. findLendexFactory :: Lendex -> App (TxOutRef, TxOutTx, [Coin]) findLendexFactory lx@Lendex{..} = findLendexInstance lx lxCoin $ \case Factory lps -> Just lps Pool _ -> Nothing +-- | Reads lendex datum for the @TxOut@. getLendexDatum :: TxOutTx -> App LendingDatum getLendexDatum o = case txOutDatumHash $ txOutTxOut o of Nothing -> throwError "datumHash not found" @@ -215,6 +248,7 @@ start = do return us -- | Creates a liquidity pool for a given coin. +-- We have no coins at the start create :: Lendex -> CreateParams -> App () create lx CreateParams{..} = do (oref, o, lps) <- findLendexFactory lx @@ -242,29 +276,26 @@ create lx CreateParams{..} = do logInfo $ "created liquidity pool: " ++ show lp +-- Type to tag Redeemer and Datum for our lending platform data Lending instance Scripts.ScriptType Lending where type RedeemerType Lending = Action type DatumType Lending = LendingDatum +-- | Schema for the super user who can initiate the whole lendex platform. type LendingOwnerSchema = BlockchainActions .\/ Endpoint "start" () +-- | Schema for lender. type LendingSchema = BlockchainActions - .\/ Endpoint "create" CreateParams + .\/ Endpoint "create" CreateParams -- create new coin to lend funds type App a = Contract () LendingSchema Text a type OwnerApp a = Contract () LendingOwnerSchema Text a -ownerEndpoint' :: Contract (Last Lendex) BlockchainActions Void () -ownerEndpoint' = do - e <- runError start - tell $ Last $ case e of - Left _err -> Nothing - Right lx -> Just lx - +-- | Endpoints for admin of the platform. Admin can initialise the lending platform. ownerEndpoint :: Contract (Last Lendex) LendingOwnerSchema Text () ownerEndpoint = forever start' where @@ -273,6 +304,7 @@ ownerEndpoint = forever start' lx <- start tell $ Last $ Just lx +-- | Endpoints for lender userEndpoints :: Lendex -> App () userEndpoints lx = forever create' where @@ -281,6 +313,9 @@ userEndpoints lx = forever create' ----------------------------------------------- -- call endpoints (for testing) +-- | Calls init lendex platform for a given wallet. +-- Produces tag of the platform that contains coin by which we track +-- state of the platform. callStart :: Wallet -> EmulatorTrace (Maybe Lendex) callStart w = do hdl <- Trace.activateContractWallet w ownerEndpoint @@ -289,7 +324,8 @@ callStart w = do Last res <- Trace.observableState hdl return res -callCreate :: Lendex ->Wallet -> CreateParams -> EmulatorTrace () +-- | Lendeer calls create coin endpoint. Coin for @CreateParams@ is used for lending purposes. +callCreate :: Lendex -> Wallet -> CreateParams -> EmulatorTrace () callCreate lx w cp = do hdl <- Trace.activateContractWallet w (userEndpoints lx) void $ Trace.callEndpoint @"create" hdl cp diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs index 49bcf062e..2f8dedb7f 100644 --- a/mlabs/test/Test/Lending.hs +++ b/mlabs/test/Test/Lending.hs @@ -1,3 +1,4 @@ +-- | Test suite for lending exchange module Test.Lending( tests ) where @@ -7,37 +8,32 @@ import Prelude import Test.Tasty import Test.Tasty.HUnit - -import Control.Monad (void) import qualified Plutus.V1.Ledger.Ada as Ada import qualified Plutus.V1.Ledger.Value as Ledger import qualified Data.Map as M import qualified PlutusTx.AssocMap as PM --------------------------------------------------------------------------------- - import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified Mlabs.Lending as L import qualified Mlabs.Lending.Coin as L +import Test.Utils + +-- | Test suite for lending exchange tests :: TestTree tests = testGroup "Lending" [ testCreate ] +-- | Tests for creation of the coin and exchange platform. testCreate :: TestTree -testCreate = testCase "Create lending pool" $ testOk initConfig createScript +testCreate = testCase "Create lending pool" $ testNoErrors initConfig createScript ------------------------------------------------------------------------------------ -currency :: Ledger.CurrencySymbol -currency = Ledger.currencySymbol "T" - -token :: Ledger.TokenName -token = Ledger.tokenName "token" - +-- | Script that creates lendex and one coin for lending. createScript :: Trace.EmulatorTrace () createScript = do mTheLendex <- L.callStart w1 @@ -49,50 +45,31 @@ createScript = do } next Nothing -> throwError "No lendex was created" - - -testOk :: Trace.EmulatorConfig -> Trace.EmulatorTrace () -> IO () -testOk cfg trace = case err of - Just e -> assertFailure $ show e - Nothing -> pure () where - err = (\(_, merr, _) -> merr) $ Trace.runEmulatorTrace cfg trace + currency = Ledger.currencySymbol "T" + token = Ledger.tokenName "token" ------------------------------------------------------------------------------------ -- init blockchain state +-- | Wallets that are used for testing. w1, w2, w3, w4 :: Wallet w1 = Wallet 1 w2 = Wallet 2 w3 = Wallet 3 w4 = Wallet 4 +-- | Initial config initConfig :: Trace.EmulatorConfig initConfig = cfg where cfg = Trace.EmulatorConfig $ Left $ M.fromList [ (w1, v1) - , (w2, v2) - , (w3, v2) - , (w4, v2) + , (w2, v1) + , (w3, v1) + , (w4, v1) ] - v1 = val 1000 10 - v2 = val 1000 0 - - val x y = Ledger.Value $ PM.fromList - [ (Ada.adaSymbol, PM.singleton Ada.adaToken x) - , (currency, PM.singleton token y)] - ------------------------------------------------------------------------------------- --- utils - -throwError :: String -> Trace.EmulatorTrace a -throwError msg = Trace.throwError (Trace.GenericError msg) - -next :: Trace.EmulatorTrace () -next = void Trace.nextSlot - -wait :: Integer -> Trace.EmulatorTrace () -wait = void . Trace.waitNSlots . fromInteger + v1 = val 1000 + val x = Ledger.Value $ PM.fromList [ (Ada.adaSymbol, PM.singleton Ada.adaToken x) ] diff --git a/mlabs/test/Test/Utils.hs b/mlabs/test/Test/Utils.hs new file mode 100644 index 000000000..899ca195f --- /dev/null +++ b/mlabs/test/Test/Utils.hs @@ -0,0 +1,32 @@ +module Test.Utils( + throwError + , next + , wait + , testNoErrors +) where + + +import Data.Functor (void) +import Test.Tasty.HUnit (assertFailure) + +import qualified Plutus.Trace.Emulator as Trace + +-- | Throws error to emulator trace. +throwError :: String -> Trace.EmulatorTrace a +throwError msg = Trace.throwError (Trace.GenericError msg) + +-- | Wait for one slot. +next :: Trace.EmulatorTrace () +next = void Trace.nextSlot + +-- | Wait given amount of slots. +wait :: Integer -> Trace.EmulatorTrace () +wait = void . Trace.waitNSlots . fromInteger + +-- | Check that there are no errors during execution of the script. +testNoErrors :: Trace.EmulatorConfig -> Trace.EmulatorTrace () -> IO () +testNoErrors cfg trace = case err of + Just e -> assertFailure $ show e + Nothing -> pure () + where + err = (\(_, merr, _) -> merr) $ Trace.runEmulatorTrace cfg trace From d3df66ec01fba1aab560bd69fdff656ea0e24fcc Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 3 May 2021 14:41:40 +0300 Subject: [PATCH 09/81] Removes redundant imports --- mlabs/src/Mlabs/Lending.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index fb9599184..3da50256d 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -23,7 +23,6 @@ import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import GHC.Generics (Generic) - import Ledger hiding (singleton) import Ledger.Constraints as Constraints import Ledger.Constraints.OnChain as Constraints From 92447db57a85cb219e932d18b024222061702148 Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 3 May 2021 16:29:53 +0300 Subject: [PATCH 10/81] Init state transition sketch --- mlabs/mlabs-plutus-use-cases.cabal | 9 +- mlabs/src/Mlabs/Lending/Logic/App.hs | 46 ++++++++ mlabs/src/Mlabs/Lending/Logic/State.hs | 56 ++++++++++ mlabs/src/Mlabs/Lending/Logic/Types.hs | 145 +++++++++++++++++++++++++ 4 files changed, 255 insertions(+), 1 deletion(-) create mode 100644 mlabs/src/Mlabs/Lending/Logic/App.hs create mode 100644 mlabs/src/Mlabs/Lending/Logic/State.hs create mode 100644 mlabs/src/Mlabs/Lending/Logic/Types.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 91fbc3061..ae7620e89 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -24,6 +24,7 @@ library , aeson , bytestring , containers + , mtl , playground-common , plutus-core , plutus-contract @@ -32,6 +33,7 @@ library , plutus-tx-plugin , plutus-pab , prettyprinter + , stm , lens , text , freer-extras @@ -39,7 +41,11 @@ library hs-source-dirs: src/ exposed-modules: Mlabs.Lending - default-extensions: ExplicitForAll + Mlabs.Lending.Logic.App + Mlabs.Lending.Logic.State + Mlabs.Lending.Logic.Types + default-extensions: BangPatterns + ExplicitForAll FlexibleContexts ScopedTypeVariables DeriveAnyClass @@ -54,6 +60,7 @@ library TemplateHaskell DataKinds TypeOperators + LambdaCase executable mlabs-plutus-use-caases main-is: Main.hs diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs new file mode 100644 index 000000000..0c25cd32b --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -0,0 +1,46 @@ +-- | Ann lending app emulator +module Mlabs.Lending.Logic.App( + App(..) + , runApp + , initApp +) where + +import Prelude + +import Control.Monad.State.Strict +import Control.Arrow (second) + +import Data.List (foldl') + +import Mlabs.Lending.Logic.Types +import Mlabs.Lending.Logic.State + +import qualified Data.Map.Strict as M + +data App = App + { app'pool :: !LendingPool + , app'log :: ![Error] + } + +runApp :: App -> [Act] -> App +runApp app acts = foldl' go app acts + where + go (App lp errs) act = case runStateT (react act) lp of + Right (_, nextState) -> App nextState errs + Left err -> App lp (err : errs) + +-- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) +initApp :: [(Coin, Rational)] -> App +initApp coins = App + { app'pool = LendingPool $ M.fromList (fmap (second initReserve) coins) + , app'log = [] + } + where + initReserve rate = Reserve + { reserve'liquidity = 0 + , reserve'borrow = 0 + , reserve'collaterals = [] + , reserve'deposits = [] + , reserve'value = rate + } + diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs new file mode 100644 index 000000000..4654e105e --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -0,0 +1,56 @@ +-- | State transitions for Lending app +module Mlabs.Lending.Logic.State( + react + , Error +) where + +import Prelude + +import Control.Monad.State.Strict + +import Data.Text +import Mlabs.Lending.Logic.Types + +type Error = Text + +type St = StateT LendingPool (Either Error) + +react :: Act -> St () +react = \case + LpAct act -> lpAct act + PriceAct act -> priceAct act + GovernAct act -> governAct act + where + lpAct = \case + DepositAct{..} -> depositAct act'amount act'asset act'onBehalfOf + BorrowAct{..} -> borrowAct act'asset act'amount act'rate act'onBehalfOf + RepayAct{..} -> repayAct act'asset act'amount act'rate act'onBehalfOf + SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct act'asset act'rate + SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct act'asset act'useAsCollateral + WithdrawAct{..} -> withdrawAct act'to act'amount act'asset + FlashLoanAct -> flashLoanAct + LiquidationCallAct{..} -> liquidationCallAct act'collateral act'debt act'user act'debtToCover act'receiveAToken + + depositAct _ _ _ = todo + borrowAct _ _ _ _ = todo + repayAct _ _ _ _ = todo + swapBorrowRateModelAct _ _ = todo + setUserReserveAsCollateralAct _ _ = todo + withdrawAct _ _ _ = todo + flashLoanAct = todo + liquidationCallAct _ _ _ _ _ = todo + + priceAct = \case + SetAssetPrice coin rate -> setAssetPrice coin rate + SetOracleAddr coin addr -> setOracleAddr coin addr + + setAssetPrice _ _ = todo + setOracleAddr _ _ = todo + + governAct = \case + AddReserve coin val -> addReserve coin val + + addReserve _ _ = todo + + todo = return () + diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs new file mode 100644 index 000000000..e50f34379 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -0,0 +1,145 @@ +-- | Types for lending app +-- +-- inspired by aave spec. See +-- +-- * https://docs.aave.com/developers/v/2.0/the-core-protocol/lendingpool +module Mlabs.Lending.Logic.Types( + LendingPool(..) + , Reserve(..) + , Act(..) + , LpAct(..) + , PriceQuery(..) + , PriceAct(..) + , GovernAct(..) + , LpAddressesProvider(..) + , LpAddressesProviderRegistry(..) + , Coin(..) + , AToken(..) + , LpCollateralManager(..) + , LpConfigurator(..) + , PriceOracleProvider(..) + , InterestRateStrategy(..) + , Collateral(..) + , Deposit(..) +) where + +import Prelude +import Data.Map.Strict (Map) +import Data.ByteString (ByteString) + +-- | Address that can hold values of assets +newtype Addr = Addr Integer + deriving (Show) + +-- | Lending pool is a list of reserves +data LendingPool = LendingPool (Map Coin Reserve) + deriving (Show) + +-- | Reserve of give coin in the pool. +-- It holds all info on individual collaterals and deposits. +data Reserve = Reserve + { reserve'liquidity :: !Integer -- ^ total amount of coins available in reserve + , reserve'borrow :: !Integer -- ^ how much was already borrowed + , reserve'collaterals :: ![Collateral] -- ^ list of collaterals + , reserve'deposits :: ![Deposit] -- ^ list of deposits + , reserve'value :: !Rational -- ^ ratio of reserve's coin to base currency + } + deriving (Show) + +-- | Colateral +data Collateral = Collateral + { collateral'amount :: Integer + , collateral'health :: Rational + , collateral'addr :: Addr + } + deriving (Show) + +-- | Deposit +data Deposit = Deposit + { deposit'amount :: Integer + , deposit'addr :: Addr + } + deriving (Show) + +data Act = LpAct LpAct | PriceAct PriceAct | GovernAct GovernAct + deriving (Show) + +-- | Lending pool action +data LpAct + = DepositAct + { act'amount :: Integer + , act'asset :: Coin + , act'onBehalfOf :: Addr + } + | BorrowAct + { act'asset :: Coin + , act'amount :: Integer + , act'rate :: InterestRate + , act'onBehalfOf :: Addr + } + | RepayAct + { act'asset :: Coin + , act'amount :: Integer + , act'rate :: InterestRate + , act'onBehalfOf :: Addr + } + | SwapBorrowRateModelAct + { act'asset :: Coin + , act'rate :: InterestRate + } + | SetUserReserveAsCollateralAct + { act'asset :: Coin + , act'useAsCollateral :: Bool + } + | WithdrawAct + { act'to :: Addr + , act'amount :: Integer + , act'asset :: Coin + } + | FlashLoanAct -- TODO + | LiquidationCallAct + { act'collateral :: Addr -- ^ collateral address + , act'debt :: Addr + , act'user :: Addr + , act'debtToCover :: Integer + , act'receiveAToken :: Bool + } + deriving (Show) + +data PriceQuery + = GetAssetPrice Coin + | GetAssetPrices [Coin] + | GetOracleAddr Coin + deriving (Show) + +data GovernAct + = AddReserve Coin Rational + deriving (Show) + +data PriceAct + = SetAssetPrice Coin Rational + | SetOracleAddr Coin Addr + deriving (Show) + +data LpAddressesProvider = LpAddressesProvider + +newtype LpAddressesProviderRegistry + = LpAddressesProviderRegistry [LpAddressesProvider] + +newtype Coin = Coin ByteString + deriving (Show, Eq, Ord) + +newtype AToken = AToken Coin + deriving (Show) + +data LpCollateralManager = LpCollateralManager + +data LpConfigurator = LpConfigurator + +data PriceOracleProvider = PriceOracleProvider + +data InterestRateStrategy = InterestRateStrategy + +data InterestRate = StableRate | VariableRate + deriving (Show) + From 125cc8894617bd027f25b00e635e0dcbde6496f7 Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 3 May 2021 17:20:21 +0300 Subject: [PATCH 11/81] Add Bch simulation --- mlabs/src/Mlabs/Lending/Logic/App.hs | 14 +++++---- mlabs/src/Mlabs/Lending/Logic/State.hs | 41 ++++++++++++++++++++++++-- mlabs/src/Mlabs/Lending/Logic/Types.hs | 3 +- 3 files changed, 50 insertions(+), 8 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 0c25cd32b..9938f0a5b 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -18,22 +18,25 @@ import Mlabs.Lending.Logic.State import qualified Data.Map.Strict as M data App = App - { app'pool :: !LendingPool - , app'log :: ![Error] + { app'pool :: !LendingPool + , app'log :: ![Error] + , app'wallets :: !BchState } + runApp :: App -> [Act] -> App runApp app acts = foldl' go app acts where - go (App lp errs) act = case runStateT (react act) lp of - Right (_, nextState) -> App nextState errs - Left err -> App lp (err : errs) + go (App lp errs wallets) act = case runStateT (react act) lp of + Right (resp, nextState) -> App nextState errs (foldl' (flip applyResp) wallets resp) + Left err -> App lp (err : errs) wallets -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: [(Coin, Rational)] -> App initApp coins = App { app'pool = LendingPool $ M.fromList (fmap (second initReserve) coins) , app'log = [] + , app'wallets = BchState M.empty } where initReserve rate = Reserve @@ -44,3 +47,4 @@ initApp coins = App , reserve'value = rate } + diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 4654e105e..ebbcf6a78 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -2,6 +2,11 @@ module Mlabs.Lending.Logic.State( react , Error + , Move(..) + , Resp(..) + , Wallet(..) + , applyResp + , BchState(..) ) where import Prelude @@ -11,11 +16,14 @@ import Control.Monad.State.Strict import Data.Text import Mlabs.Lending.Logic.Types +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M + type Error = Text type St = StateT LendingPool (Either Error) -react :: Act -> St () +react :: Act -> St [Resp] react = \case LpAct act -> lpAct act PriceAct act -> priceAct act @@ -52,5 +60,34 @@ react = \case addReserve _ _ = todo - todo = return () + todo = return [] + +---------------------------------------------------- +-- simple emulation ob blockchain state + +-- | Blockchain state is a set of wallets +newtype BchState = BchState (Map Addr Wallet) + +-- " For simplicity wallet is a map of coins to balances. +newtype Wallet = Wallet (Map Coin Integer) + +-- | We can give money to vallets and take it from them +data Resp + = MoveTo Move + +-- | Moving funds +data Move = Move + { move'addr :: Addr -- where move happens + , move'coin :: Coin -- on which value + , move'amount :: Integer -- how many to add (can be negative) + } + +applyResp :: Resp -> BchState -> BchState +applyResp resp (BchState wallets) = BchState $ case resp of + MoveTo act -> moveTo act wallets + where + moveTo Move{..} m = updateWallet move'addr move'coin move'amount m + + updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m + updateBalance coin amt (Wallet bals) = Wallet $ M.update (\x -> Just (x + amt)) coin bals diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index e50f34379..423caae24 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -14,6 +14,7 @@ module Mlabs.Lending.Logic.Types( , LpAddressesProvider(..) , LpAddressesProviderRegistry(..) , Coin(..) + , Addr(..) , AToken(..) , LpCollateralManager(..) , LpConfigurator(..) @@ -29,7 +30,7 @@ import Data.ByteString (ByteString) -- | Address that can hold values of assets newtype Addr = Addr Integer - deriving (Show) + deriving (Show, Eq, Ord) -- | Lending pool is a list of reserves data LendingPool = LendingPool (Map Coin Reserve) From 679c61b0b34142c566d94b0be186c02a9dd01d1e Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 4 May 2021 16:12:30 +0300 Subject: [PATCH 12/81] Implements deposit and borrow actions --- mlabs/src/Mlabs/Lending/Logic/App.hs | 11 +- mlabs/src/Mlabs/Lending/Logic/State.hs | 213 ++++++++++++++++++++++--- mlabs/src/Mlabs/Lending/Logic/Types.hs | 86 +++++++--- 3 files changed, 255 insertions(+), 55 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 9938f0a5b..5d99a3ae9 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -34,17 +34,8 @@ runApp app acts = foldl' go app acts -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: [(Coin, Rational)] -> App initApp coins = App - { app'pool = LendingPool $ M.fromList (fmap (second initReserve) coins) + { app'pool = LendingPool (M.fromList (fmap (second initReserve) coins)) mempty , app'log = [] , app'wallets = BchState M.empty } - where - initReserve rate = Reserve - { reserve'liquidity = 0 - , reserve'borrow = 0 - , reserve'collaterals = [] - , reserve'deposits = [] - , reserve'value = rate - } - diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index ebbcf6a78..0def246cb 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -7,46 +7,128 @@ module Mlabs.Lending.Logic.State( , Wallet(..) , applyResp , BchState(..) + , initReserve ) where import Prelude +import Control.Monad.Except import Control.Monad.State.Strict +import Data.Maybe import Data.Text import Mlabs.Lending.Logic.Types import Data.Map.Strict (Map) import qualified Data.Map.Strict as M +import qualified Data.Text as T + +showt :: Show a => a -> Text +showt = T.pack . show type Error = Text +-- | State update of lending pool type St = StateT LendingPool (Either Error) +-- | State transition for lending pool. +-- For a given action we update internal state of Lending pool and produce +-- list of responses to simulate change of the balances react :: Act -> St [Resp] react = \case - LpAct act -> lpAct act - PriceAct act -> priceAct act - GovernAct act -> governAct act + UserAct uid act -> userAct uid act + PriceAct act -> priceAct act + GovernAct act -> governAct act where - lpAct = \case - DepositAct{..} -> depositAct act'amount act'asset act'onBehalfOf - BorrowAct{..} -> borrowAct act'asset act'amount act'rate act'onBehalfOf - RepayAct{..} -> repayAct act'asset act'amount act'rate act'onBehalfOf - SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct act'asset act'rate - SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct act'asset act'useAsCollateral - WithdrawAct{..} -> withdrawAct act'to act'amount act'asset - FlashLoanAct -> flashLoanAct - LiquidationCallAct{..} -> liquidationCallAct act'collateral act'debt act'user act'debtToCover act'receiveAToken - - depositAct _ _ _ = todo - borrowAct _ _ _ _ = todo + userAct uid = \case + DepositAct{..} -> depositAct uid act'amount act'asset + BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate + RepayAct{..} -> repayAct uid act'asset act'amount act'rate + SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate + SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral + WithdrawAct{..} -> withdrawAct uid act'amount act'asset + FlashLoanAct -> flashLoanAct uid + LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken + + -- TODO: ignores ratio of liquidity to borrowed totals + depositAct uid amount asset = do + modifyReserve asset (Right . depositReserve) + modifyWallet uid asset (Right . depositUser) + let move a b = MoveTo $ Move uid a b + pure + [ move asset (negate amount) + , move (aToken asset) amount + ] + where + depositReserve r@Reserve{..} = r { reserve'deposit = amount + reserve'deposit } + depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } + + -- TODO: ignores rate strategy (stable vs variable), ratio of liquidity to borrowed totals, health-check + -- For borrowing to be valid we check that + -- * reserve has enough liquidity + -- * user does not use collateral reserve to borrow (it's meaningless for the user) + -- * user has enough collateral for the borrow + borrowAct uid asset amount _rate = do + hasEnoughLiquidity asset amount + collateralNonBorrow uid asset + hasEnoughCollateral uid asset amount + updateReserveOnBorrow + updateUserOnBorrow + pure [ MoveTo $ Move uid asset amount ] + where + updateReserveOnBorrow = modifyReserve asset $ \r -> Right $ r + { reserve'deposit = reserve'deposit r - amount + , reserve'borrow = reserve'borrow r + amount + } + + updateUserOnBorrow = modifyWallet uid asset $ \w -> Right $ w + { wallet'deposit = wallet'deposit w - amount + , wallet'borrow = wallet'borrow w + amount + } + + hasEnoughLiquidity asset amount = do + liquidity <- getsReserve asset reserve'deposit + guardError ("Not enough liquidity for asset " <> showt asset) + (liquidity >= amount) + + collateralNonBorrow uid asset = do + col <- getsWallet uid asset wallet'collateral + guardError ("Collateral can not be used as borrow for user " <> showt uid <> " for asset " <> showt asset) + (col == 0) + + hasEnoughCollateral uid asset amount = do + bor <- toAda asset amount + isOk <- getHealthCheck bor asset =<< getUser uid + guardError msg isOk + where + msg = mconcat [ "Not enough collateral to borrow ", showt amount, " ", showt asset, " for user ", showt uid] + + repayAct _ _ _ _ = todo - swapBorrowRateModelAct _ _ = todo - setUserReserveAsCollateralAct _ _ = todo + swapBorrowRateModelAct _ _ _ = todo + setUserReserveAsCollateralAct _ _ _ = todo withdrawAct _ _ _ = todo - flashLoanAct = todo - liquidationCallAct _ _ _ _ _ = todo + flashLoanAct _ = todo + liquidationCallAct _ _ _ _ _ _ = todo + + modifyReserve :: Coin -> (Reserve -> Either Text Reserve) -> St () + modifyReserve asset f = do + LendingPool lp users <- get + case M.lookup asset lp of + Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users) (f reserve) + Nothing -> throwError $ mconcat ["Asset is not supported: ", showt asset] + + modifyUser :: UserId -> (User -> Either Text User) -> St () + modifyUser uid f = do + LendingPool lp users <- get + case f $ fromMaybe defaultUser $ M.lookup uid users of + Left msg -> throwError msg + Right user -> put $ LendingPool lp (M.insert uid user users) + + modifyWallet :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () + modifyWallet uid coin f = modifyUser uid $ \(User ws) -> do + wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws + pure $ User $ M.insert coin wal ws priceAct = \case SetAssetPrice coin rate -> setAssetPrice coin rate @@ -58,18 +140,98 @@ react = \case governAct = \case AddReserve coin val -> addReserve coin val - addReserve _ _ = todo + addReserve coin val = do + LendingPool reserves users <- get + if M.member coin reserves + then throwError "Reserve is already present" + else do + put $ LendingPool (M.insert coin (initReserve val) reserves) users + return [] todo = return [] +---------------------------------------------------- +-- common functions + +guardError :: Text -> Bool -> St () +guardError msg isTrue + | isTrue = pure () + | otherwise = throwError msg + +getsWallet :: UserId -> Coin -> (Wallet -> a) -> St a +getsWallet uid coin f = fmap f $ getWallet uid coin + +getWallet :: UserId -> Coin -> St Wallet +getWallet uid coin = + getsUser uid (fromMaybe defaultWallet . M.lookup coin . user'wallets) + +getsUser :: UserId -> (User -> a) -> St a +getsUser uid f = fmap f $ getUser uid + +getUser :: UserId -> St User +getUser uid = gets (fromMaybe defaultUser . M.lookup uid . lp'users) + +getsReserve :: Coin -> (Reserve -> a) -> St a +getsReserve coin extract = fmap extract $ getReserve coin + +getReserve :: Coin -> St Reserve +getReserve coin = do + mReserve <- gets (M.lookup coin . lp'reserves) + maybe err pure mReserve + where + err = throwError $ "Uknown coin " <> showt coin + +-- | Convert given currency to base currency +toAda :: Coin -> Integer -> St Integer +toAda coin val = do + ratio <- fmap reserve'rate $ getReserve coin + pure $ ceiling $ fromInteger val * ratio + +-- | Weigted total of currencies in base currency +weightedTotal :: [(Coin, Integer)] -> St Integer +weightedTotal = fmap sum . mapM (uncurry toAda) + +-- | Collects cumulative value for given wallet field +walletTotal :: (Wallet -> Integer) -> User -> St Integer +walletTotal extract (User ws) = weightedTotal $ M.toList $ fmap extract ws + +-- | Gets total collateral for a user. +getTotalCollateral :: User -> St Integer +getTotalCollateral = walletTotal wallet'collateral + +-- | Gets total borrows for a user in base currency. +getTotalBorrow :: User -> St Integer +getTotalBorrow = walletTotal wallet'borrow + +{- +-- | Gets total deposit for a user in base currency. +getTotalDeposit :: User -> St Integer +getTotalDeposit = walletTotal wallet'deposit +-} + +getHealthCheck :: Integer -> Coin -> User -> St Bool +getHealthCheck addToBorrow coin user = fmap (> 1) $ getHealth addToBorrow coin user + +-- | Check borrowing health for the user by given currency +getHealth :: Integer -> Coin -> User -> St Rational +getHealth addToBorrow coin user = do + col <- getTotalCollateral user + bor <- fmap (+ addToBorrow) $ getTotalBorrow user + liq <- getLiquidationThreshold coin + pure $ fromInteger col * liq / fromInteger bor + +getLiquidationThreshold :: Coin -> St Rational +getLiquidationThreshold coin = + gets (maybe 0 reserve'liquidationThreshold . M.lookup coin . lp'reserves) + ---------------------------------------------------- -- simple emulation ob blockchain state -- | Blockchain state is a set of wallets -newtype BchState = BchState (Map Addr Wallet) +newtype BchState = BchState (Map UserId BchWallet) -- " For simplicity wallet is a map of coins to balances. -newtype Wallet = Wallet (Map Coin Integer) +newtype BchWallet = BchWallet (Map Coin Integer) -- | We can give money to vallets and take it from them data Resp @@ -77,17 +239,18 @@ data Resp -- | Moving funds data Move = Move - { move'addr :: Addr -- where move happens + { move'addr :: UserId -- where move happens , move'coin :: Coin -- on which value , move'amount :: Integer -- how many to add (can be negative) } +-- | Applies reponse to the blockchain state. applyResp :: Resp -> BchState -> BchState applyResp resp (BchState wallets) = BchState $ case resp of MoveTo act -> moveTo act wallets where - moveTo Move{..} m = updateWallet move'addr move'coin move'amount m + moveTo Move{..} m = updateWallet move'addr move'coin move'amount m updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m - updateBalance coin amt (Wallet bals) = Wallet $ M.update (\x -> Just (x + amt)) coin bals + updateBalance coin amt (BchWallet bals) = BchWallet $ M.update (\x -> Just (x + amt)) coin bals diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 423caae24..640b0e333 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -5,17 +5,23 @@ -- * https://docs.aave.com/developers/v/2.0/the-core-protocol/lendingpool module Mlabs.Lending.Logic.Types( LendingPool(..) + , Wallet(..) + , defaultWallet + , User(..) + , defaultUser + , UserId(..) , Reserve(..) + , initReserve , Act(..) - , LpAct(..) + , UserAct(..) , PriceQuery(..) , PriceAct(..) , GovernAct(..) , LpAddressesProvider(..) , LpAddressesProviderRegistry(..) , Coin(..) + , aToken , Addr(..) - , AToken(..) , LpCollateralManager(..) , LpConfigurator(..) , PriceOracleProvider(..) @@ -32,57 +38,97 @@ import Data.ByteString (ByteString) newtype Addr = Addr Integer deriving (Show, Eq, Ord) +newtype UserId = UserId Integer + deriving (Show, Eq, Ord) + -- | Lending pool is a list of reserves -data LendingPool = LendingPool (Map Coin Reserve) +data LendingPool = LendingPool + { lp'reserves :: Map Coin Reserve + , lp'users :: Map UserId User + } deriving (Show) -- | Reserve of give coin in the pool. -- It holds all info on individual collaterals and deposits. data Reserve = Reserve - { reserve'liquidity :: !Integer -- ^ total amount of coins available in reserve - , reserve'borrow :: !Integer -- ^ how much was already borrowed - , reserve'collaterals :: ![Collateral] -- ^ list of collaterals - , reserve'deposits :: ![Deposit] -- ^ list of deposits - , reserve'value :: !Rational -- ^ ratio of reserve's coin to base currency + { reserve'deposit :: !Integer -- ^ total amount of coins deposited to reserve + , reserve'collateral :: !Integer -- ^ total amount of collaterals on the reserve + , reserve'borrow :: !Integer -- ^ how much was already borrowed + , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency + , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin + } + deriving (Show) + +-- | Initialise empty reserve with given ratio of its coin to ada +initReserve :: Rational -> Reserve +initReserve rate = Reserve + { reserve'deposit = 0 + , reserve'borrow = 0 + , reserve'collateral = 0 + , reserve'rate = rate + , reserve'liquidationThreshold = 0.8 + } + +data User = User + { user'wallets :: Map Coin Wallet + } + deriving (Show) + +defaultUser :: User +defaultUser = User mempty + +data Wallet = Wallet + { wallet'deposit :: Integer + , wallet'collateral :: Integer + , wallet'borrow :: Integer + } + deriving (Show) + +defaultWallet :: Wallet +defaultWallet = Wallet 0 0 0 + +data UserConfig = UserConfig + { userConfig'collaterals :: [Addr] + , userConfig'borrows :: [Borrow] + } + deriving (Show) + +data Borrow = Borrow + { borrow'amount :: Integer + , borrow'health :: Rational } deriving (Show) -- | Colateral data Collateral = Collateral { collateral'amount :: Integer - , collateral'health :: Rational - , collateral'addr :: Addr } deriving (Show) -- | Deposit data Deposit = Deposit { deposit'amount :: Integer - , deposit'addr :: Addr } deriving (Show) -data Act = LpAct LpAct | PriceAct PriceAct | GovernAct GovernAct +data Act = UserAct UserId UserAct | PriceAct PriceAct | GovernAct GovernAct deriving (Show) -- | Lending pool action -data LpAct +data UserAct = DepositAct { act'amount :: Integer , act'asset :: Coin - , act'onBehalfOf :: Addr } | BorrowAct { act'asset :: Coin , act'amount :: Integer , act'rate :: InterestRate - , act'onBehalfOf :: Addr } | RepayAct { act'asset :: Coin , act'amount :: Integer , act'rate :: InterestRate - , act'onBehalfOf :: Addr } | SwapBorrowRateModelAct { act'asset :: Coin @@ -93,8 +139,7 @@ data LpAct , act'useAsCollateral :: Bool } | WithdrawAct - { act'to :: Addr - , act'amount :: Integer + { act'amount :: Integer , act'asset :: Coin } | FlashLoanAct -- TODO @@ -130,8 +175,9 @@ newtype LpAddressesProviderRegistry newtype Coin = Coin ByteString deriving (Show, Eq, Ord) -newtype AToken = AToken Coin - deriving (Show) +-- | Appends a prefix to all coins +aToken :: Coin -> Coin +aToken (Coin bs) = Coin $ "a" <> bs data LpCollateralManager = LpCollateralManager From 35faaf56eac2f3fb0dd21b6bf84d7f8b46b4c6ac Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 4 May 2021 17:49:44 +0300 Subject: [PATCH 13/81] Implements setUserAsCollateral --- mlabs/src/Mlabs/Lending/Logic/State.hs | 41 ++++++++++++++++++++++++-- mlabs/src/Mlabs/Lending/Logic/Types.hs | 5 ++-- 2 files changed, 42 insertions(+), 4 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 0def246cb..239dc7cd2 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -45,7 +45,7 @@ react = \case BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate RepayAct{..} -> repayAct uid act'asset act'amount act'rate SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate - SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral + SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion 1) WithdrawAct{..} -> withdrawAct uid act'amount act'asset FlashLoanAct -> flashLoanAct uid LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken @@ -106,7 +106,44 @@ react = \case repayAct _ _ _ _ = todo swapBorrowRateModelAct _ _ _ = todo - setUserReserveAsCollateralAct _ _ _ = todo + + setUserReserveAsCollateralAct uid asset useAsCollateral portion + | useAsCollateral = setAsCollateral uid asset portion + | otherwise = setAsDeposit uid asset portion + + setAsCollateral uid asset portion + | portion <= 0 = pure [] + | otherwise = do + amount <- getAmountBy wallet'deposit uid asset portion + modifyWallet uid asset $ \w -> Right $ w + { wallet'deposit = wallet'deposit w - amount + , wallet'collateral = wallet'collateral w + amount + } + modifyReserve asset $ \r -> Right $ r + { reserve'deposit = reserve'deposit r - amount + , reserve'collateral = reserve'collateral r + amount + } + pure [ MoveTo $ Move uid (aToken asset) (negate amount) ] + + setAsDeposit uid asset portion + | portion <= 0 = pure [] + | otherwise = do + amount <- getAmountBy wallet'collateral uid asset portion + modifyWallet uid asset $ \w -> Right $ w + { wallet'deposit = wallet'deposit w + amount + , wallet'collateral = wallet'collateral w - amount + } + modifyReserve asset $ \r -> Right $ r + { reserve'deposit = reserve'deposit r + amount + , reserve'collateral = reserve'collateral r - amount + } + pure [ MoveTo $ Move uid (aToken asset) amount ] + + getAmountBy extract uid asset portion = do + val <- getsWallet uid asset extract + pure $ floor $ portion * fromInteger val + + withdrawAct _ _ _ = todo flashLoanAct _ = todo liquidationCallAct _ _ _ _ _ _ = todo diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 640b0e333..3d5902e74 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -135,8 +135,9 @@ data UserAct , act'rate :: InterestRate } | SetUserReserveAsCollateralAct - { act'asset :: Coin - , act'useAsCollateral :: Bool + { act'asset :: Coin -- ^ which asset to use as collateral or not + , act'useAsCollateral :: Bool -- ^ should we use as collateral (True) or use as deposit (False) + , act'portion :: Rational -- ^ poriton of deposit/collateral to change status (0, 1) } | WithdrawAct { act'amount :: Integer From af51d7afbb02545f65a922b4e392eb3f4d3fe82a Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 4 May 2021 18:11:29 +0300 Subject: [PATCH 14/81] Refactoring --- mlabs/mlabs-plutus-use-cases.cabal | 2 + mlabs/src/Mlabs/Lending/Logic/App.hs | 3 +- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 41 ++++ mlabs/src/Mlabs/Lending/Logic/React.hs | 135 +++++++++++++ mlabs/src/Mlabs/Lending/Logic/State.hs | 235 ++++------------------ mlabs/src/Mlabs/Lending/Logic/Types.hs | 28 +-- 6 files changed, 235 insertions(+), 209 deletions(-) create mode 100644 mlabs/src/Mlabs/Lending/Logic/Emulator.hs create mode 100644 mlabs/src/Mlabs/Lending/Logic/React.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index ae7620e89..326cb8f7b 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -42,6 +42,8 @@ library exposed-modules: Mlabs.Lending Mlabs.Lending.Logic.App + Mlabs.Lending.Logic.Emulator + Mlabs.Lending.Logic.React Mlabs.Lending.Logic.State Mlabs.Lending.Logic.Types default-extensions: BangPatterns diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 5d99a3ae9..8306507d9 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -12,6 +12,8 @@ import Control.Arrow (second) import Data.List (foldl') +import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types import Mlabs.Lending.Logic.State @@ -23,7 +25,6 @@ data App = App , app'wallets :: !BchState } - runApp :: App -> [Act] -> App runApp app acts = foldl' go app acts where diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs new file mode 100644 index 000000000..a97928064 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -0,0 +1,41 @@ +-- | Simple emulation ob blockchain state +module Mlabs.Lending.Logic.Emulator( + BchState(..) + , BchWallet(..) + , Resp(..) + , Move(..) + , applyResp +) where + +import Data.Map.Strict (Map) +import Mlabs.Lending.Logic.Types + +import qualified Data.Map.Strict as M + +-- | Blockchain state is a set of wallets +newtype BchState = BchState (Map UserId BchWallet) + +-- " For simplicity wallet is a map of coins to balances. +newtype BchWallet = BchWallet (Map Coin Integer) + +-- | We can give money to vallets and take it from them +data Resp + = MoveTo Move + +-- | Moving funds +data Move = Move + { move'addr :: UserId -- where move happens + , move'coin :: Coin -- on which value + , move'amount :: Integer -- how many to add (can be negative) + } + +-- | Applies reponse to the blockchain state. +applyResp :: Resp -> BchState -> BchState +applyResp resp (BchState wallets) = BchState $ case resp of + MoveTo act -> moveTo act wallets + where + moveTo Move{..} m = updateWallet move'addr move'coin move'amount m + + updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m + updateBalance coin amt (BchWallet bals) = BchWallet $ M.update (\x -> Just (x + amt)) coin bals + diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs new file mode 100644 index 000000000..c45387617 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -0,0 +1,135 @@ +-- | State transitions for Aave-like application +module Mlabs.Lending.Logic.React( + react +) where + +import Control.Monad.Except +import Control.Monad.State.Strict + +import qualified Data.Map.Strict as M + +import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.State +import Mlabs.Lending.Logic.Types + +-- | State transition for lending pool. +-- For a given action we update internal state of Lending pool and produce +-- list of responses to simulate change of the balances +react :: Act -> St [Resp] +react = \case + UserAct uid act -> userAct uid act + PriceAct act -> priceAct act + GovernAct act -> governAct act + where + userAct uid = \case + DepositAct{..} -> depositAct uid act'amount act'asset + BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate + RepayAct{..} -> repayAct uid act'asset act'amount act'rate + SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate + SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion 1) + WithdrawAct{..} -> withdrawAct uid act'amount act'asset + FlashLoanAct -> flashLoanAct uid + LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken + + -- TODO: ignores ratio of liquidity to borrowed totals + depositAct uid amount asset = do + modifyWalletAndReserve uid asset (Right . depositUser) + let move a b = MoveTo $ Move uid a b + pure + [ move asset (negate amount) + , move (aToken asset) amount + ] + where + depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } + + -- TODO: ignores rate strategy (stable vs variable), ratio of liquidity to borrowed totals, health-check + -- For borrowing to be valid we check that + -- * reserve has enough liquidity + -- * user does not use collateral reserve to borrow (it's meaningless for the user) + -- * user has enough collateral for the borrow + borrowAct uid asset amount _rate = do + hasEnoughLiquidity asset amount + collateralNonBorrow uid asset + hasEnoughCollateral uid asset amount + updateOnBorrow + pure [ MoveTo $ Move uid asset amount ] + where + updateOnBorrow = modifyWalletAndReserve uid asset $ \w -> Right $ w + { wallet'deposit = wallet'deposit w - amount + , wallet'borrow = wallet'borrow w + amount + } + + hasEnoughLiquidity asset amount = do + liquidity <- getsReserve asset (wallet'deposit . reserve'wallet) + guardError ("Not enough liquidity for asset " <> showt asset) + (liquidity >= amount) + + collateralNonBorrow uid asset = do + col <- getsWallet uid asset wallet'collateral + guardError ("Collateral can not be used as borrow for user " <> showt uid <> " for asset " <> showt asset) + (col == 0) + + hasEnoughCollateral uid asset amount = do + bor <- toAda asset amount + isOk <- getHealthCheck bor asset =<< getUser uid + guardError msg isOk + where + msg = mconcat [ "Not enough collateral to borrow ", showt amount, " ", showt asset, " for user ", showt uid] + + + repayAct _ _ _ _ = todo + swapBorrowRateModelAct _ _ _ = todo + + setUserReserveAsCollateralAct uid asset useAsCollateral portion + | useAsCollateral = setAsCollateral uid asset portion + | otherwise = setAsDeposit uid asset portion + + setAsCollateral uid asset portion + | portion <= 0 = pure [] + | otherwise = do + amount <- getAmountBy wallet'deposit uid asset portion + modifyWalletAndReserve uid asset $ \w -> Right $ w + { wallet'deposit = wallet'deposit w - amount + , wallet'collateral = wallet'collateral w + amount + } + pure [ MoveTo $ Move uid (aToken asset) (negate amount) ] + + setAsDeposit uid asset portion + | portion <= 0 = pure [] + | otherwise = do + amount <- getAmountBy wallet'collateral uid asset portion + modifyWalletAndReserve uid asset $ \w -> Right $ w + { wallet'deposit = wallet'deposit w + amount + , wallet'collateral = wallet'collateral w - amount + } + pure [ MoveTo $ Move uid (aToken asset) amount ] + + getAmountBy extract uid asset portion = do + val <- getsWallet uid asset extract + pure $ floor $ portion * fromInteger val + + + withdrawAct _ _ _ = todo + flashLoanAct _ = todo + liquidationCallAct _ _ _ _ _ _ = todo + + priceAct = \case + SetAssetPrice coin rate -> setAssetPrice coin rate + SetOracleAddr coin addr -> setOracleAddr coin addr + + setAssetPrice _ _ = todo + setOracleAddr _ _ = todo + + governAct = \case + AddReserve coin val -> addReserve coin val + + addReserve coin val = do + LendingPool reserves users <- get + if M.member coin reserves + then throwError "Reserve is already present" + else do + put $ LendingPool (M.insert coin (initReserve val) reserves) users + return [] + + todo = return [] + diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 239dc7cd2..531b6c3a6 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -1,13 +1,24 @@ -- | State transitions for Lending app module Mlabs.Lending.Logic.State( - react + St + , showt , Error - , Move(..) - , Resp(..) - , Wallet(..) - , applyResp - , BchState(..) , initReserve + , guardError + , getWallet, getsWallet + , getUser, getsUser + , getReserve, getsReserve + , toAda + , getTotalCollateral + , getTotalBorrow + , getTotalDeposit + , getLiquidationThreshold + , getHealth + , getHealthCheck + , modifyReserve + , modifyUser + , modifyWallet + , modifyWalletAndReserve ) where import Prelude @@ -19,7 +30,6 @@ import Data.Maybe import Data.Text import Mlabs.Lending.Logic.Types -import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import qualified Data.Text as T @@ -31,162 +41,6 @@ type Error = Text -- | State update of lending pool type St = StateT LendingPool (Either Error) --- | State transition for lending pool. --- For a given action we update internal state of Lending pool and produce --- list of responses to simulate change of the balances -react :: Act -> St [Resp] -react = \case - UserAct uid act -> userAct uid act - PriceAct act -> priceAct act - GovernAct act -> governAct act - where - userAct uid = \case - DepositAct{..} -> depositAct uid act'amount act'asset - BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate - RepayAct{..} -> repayAct uid act'asset act'amount act'rate - SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate - SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion 1) - WithdrawAct{..} -> withdrawAct uid act'amount act'asset - FlashLoanAct -> flashLoanAct uid - LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken - - -- TODO: ignores ratio of liquidity to borrowed totals - depositAct uid amount asset = do - modifyReserve asset (Right . depositReserve) - modifyWallet uid asset (Right . depositUser) - let move a b = MoveTo $ Move uid a b - pure - [ move asset (negate amount) - , move (aToken asset) amount - ] - where - depositReserve r@Reserve{..} = r { reserve'deposit = amount + reserve'deposit } - depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } - - -- TODO: ignores rate strategy (stable vs variable), ratio of liquidity to borrowed totals, health-check - -- For borrowing to be valid we check that - -- * reserve has enough liquidity - -- * user does not use collateral reserve to borrow (it's meaningless for the user) - -- * user has enough collateral for the borrow - borrowAct uid asset amount _rate = do - hasEnoughLiquidity asset amount - collateralNonBorrow uid asset - hasEnoughCollateral uid asset amount - updateReserveOnBorrow - updateUserOnBorrow - pure [ MoveTo $ Move uid asset amount ] - where - updateReserveOnBorrow = modifyReserve asset $ \r -> Right $ r - { reserve'deposit = reserve'deposit r - amount - , reserve'borrow = reserve'borrow r + amount - } - - updateUserOnBorrow = modifyWallet uid asset $ \w -> Right $ w - { wallet'deposit = wallet'deposit w - amount - , wallet'borrow = wallet'borrow w + amount - } - - hasEnoughLiquidity asset amount = do - liquidity <- getsReserve asset reserve'deposit - guardError ("Not enough liquidity for asset " <> showt asset) - (liquidity >= amount) - - collateralNonBorrow uid asset = do - col <- getsWallet uid asset wallet'collateral - guardError ("Collateral can not be used as borrow for user " <> showt uid <> " for asset " <> showt asset) - (col == 0) - - hasEnoughCollateral uid asset amount = do - bor <- toAda asset amount - isOk <- getHealthCheck bor asset =<< getUser uid - guardError msg isOk - where - msg = mconcat [ "Not enough collateral to borrow ", showt amount, " ", showt asset, " for user ", showt uid] - - - repayAct _ _ _ _ = todo - swapBorrowRateModelAct _ _ _ = todo - - setUserReserveAsCollateralAct uid asset useAsCollateral portion - | useAsCollateral = setAsCollateral uid asset portion - | otherwise = setAsDeposit uid asset portion - - setAsCollateral uid asset portion - | portion <= 0 = pure [] - | otherwise = do - amount <- getAmountBy wallet'deposit uid asset portion - modifyWallet uid asset $ \w -> Right $ w - { wallet'deposit = wallet'deposit w - amount - , wallet'collateral = wallet'collateral w + amount - } - modifyReserve asset $ \r -> Right $ r - { reserve'deposit = reserve'deposit r - amount - , reserve'collateral = reserve'collateral r + amount - } - pure [ MoveTo $ Move uid (aToken asset) (negate amount) ] - - setAsDeposit uid asset portion - | portion <= 0 = pure [] - | otherwise = do - amount <- getAmountBy wallet'collateral uid asset portion - modifyWallet uid asset $ \w -> Right $ w - { wallet'deposit = wallet'deposit w + amount - , wallet'collateral = wallet'collateral w - amount - } - modifyReserve asset $ \r -> Right $ r - { reserve'deposit = reserve'deposit r + amount - , reserve'collateral = reserve'collateral r - amount - } - pure [ MoveTo $ Move uid (aToken asset) amount ] - - getAmountBy extract uid asset portion = do - val <- getsWallet uid asset extract - pure $ floor $ portion * fromInteger val - - - withdrawAct _ _ _ = todo - flashLoanAct _ = todo - liquidationCallAct _ _ _ _ _ _ = todo - - modifyReserve :: Coin -> (Reserve -> Either Text Reserve) -> St () - modifyReserve asset f = do - LendingPool lp users <- get - case M.lookup asset lp of - Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users) (f reserve) - Nothing -> throwError $ mconcat ["Asset is not supported: ", showt asset] - - modifyUser :: UserId -> (User -> Either Text User) -> St () - modifyUser uid f = do - LendingPool lp users <- get - case f $ fromMaybe defaultUser $ M.lookup uid users of - Left msg -> throwError msg - Right user -> put $ LendingPool lp (M.insert uid user users) - - modifyWallet :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () - modifyWallet uid coin f = modifyUser uid $ \(User ws) -> do - wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws - pure $ User $ M.insert coin wal ws - - priceAct = \case - SetAssetPrice coin rate -> setAssetPrice coin rate - SetOracleAddr coin addr -> setOracleAddr coin addr - - setAssetPrice _ _ = todo - setOracleAddr _ _ = todo - - governAct = \case - AddReserve coin val -> addReserve coin val - - addReserve coin val = do - LendingPool reserves users <- get - if M.member coin reserves - then throwError "Reserve is already present" - else do - put $ LendingPool (M.insert coin (initReserve val) reserves) users - return [] - - todo = return [] - ---------------------------------------------------- -- common functions @@ -240,11 +94,9 @@ getTotalCollateral = walletTotal wallet'collateral getTotalBorrow :: User -> St Integer getTotalBorrow = walletTotal wallet'borrow -{- -- | Gets total deposit for a user in base currency. getTotalDeposit :: User -> St Integer getTotalDeposit = walletTotal wallet'deposit --} getHealthCheck :: Integer -> Coin -> User -> St Bool getHealthCheck addToBorrow coin user = fmap (> 1) $ getHealth addToBorrow coin user @@ -261,33 +113,28 @@ getLiquidationThreshold :: Coin -> St Rational getLiquidationThreshold coin = gets (maybe 0 reserve'liquidationThreshold . M.lookup coin . lp'reserves) ----------------------------------------------------- --- simple emulation ob blockchain state - --- | Blockchain state is a set of wallets -newtype BchState = BchState (Map UserId BchWallet) - --- " For simplicity wallet is a map of coins to balances. -newtype BchWallet = BchWallet (Map Coin Integer) - --- | We can give money to vallets and take it from them -data Resp - = MoveTo Move - --- | Moving funds -data Move = Move - { move'addr :: UserId -- where move happens - , move'coin :: Coin -- on which value - , move'amount :: Integer -- how many to add (can be negative) - } - --- | Applies reponse to the blockchain state. -applyResp :: Resp -> BchState -> BchState -applyResp resp (BchState wallets) = BchState $ case resp of - MoveTo act -> moveTo act wallets - where - moveTo Move{..} m = updateWallet move'addr move'coin move'amount m - - updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m - updateBalance coin amt (BchWallet bals) = BchWallet $ M.update (\x -> Just (x + amt)) coin bals +modifyReserve :: Coin -> (Reserve -> Either Text Reserve) -> St () +modifyReserve asset f = do + LendingPool lp users <- get + case M.lookup asset lp of + Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users) (f reserve) + Nothing -> throwError $ mconcat ["Asset is not supported: ", showt asset] + +modifyUser :: UserId -> (User -> Either Text User) -> St () +modifyUser uid f = do + LendingPool lp users <- get + case f $ fromMaybe defaultUser $ M.lookup uid users of + Left msg -> throwError msg + Right user -> put $ LendingPool lp (M.insert uid user users) + +-- | Applies the same modification function to the user and to the reserve wallet. +modifyWalletAndReserve :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () +modifyWalletAndReserve uid coin f = do + modifyWallet uid coin f + modifyReserve coin $ \r -> fmap (\w -> r { reserve'wallet = w }) $ f $ reserve'wallet r + +modifyWallet :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () +modifyWallet uid coin f = modifyUser uid $ \(User ws) -> do + wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws + pure $ User $ M.insert coin wal ws diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 3d5902e74..3bd7af8a1 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -43,18 +43,16 @@ newtype UserId = UserId Integer -- | Lending pool is a list of reserves data LendingPool = LendingPool - { lp'reserves :: Map Coin Reserve - , lp'users :: Map UserId User + { lp'reserves :: !(Map Coin Reserve) + , lp'users :: !(Map UserId User) } deriving (Show) -- | Reserve of give coin in the pool. -- It holds all info on individual collaterals and deposits. data Reserve = Reserve - { reserve'deposit :: !Integer -- ^ total amount of coins deposited to reserve - , reserve'collateral :: !Integer -- ^ total amount of collaterals on the reserve - , reserve'borrow :: !Integer -- ^ how much was already borrowed - , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency + { reserve'wallet :: !Wallet -- ^ total amounts of coins deposited to reserve + , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin } deriving (Show) @@ -62,15 +60,17 @@ data Reserve = Reserve -- | Initialise empty reserve with given ratio of its coin to ada initReserve :: Rational -> Reserve initReserve rate = Reserve - { reserve'deposit = 0 - , reserve'borrow = 0 - , reserve'collateral = 0 - , reserve'rate = rate + { reserve'wallet = Wallet + { wallet'deposit = 0 + , wallet'borrow = 0 + , wallet'collateral = 0 + } + , reserve'rate = rate , reserve'liquidationThreshold = 0.8 } data User = User - { user'wallets :: Map Coin Wallet + { user'wallets :: !(Map Coin Wallet) } deriving (Show) @@ -78,9 +78,9 @@ defaultUser :: User defaultUser = User mempty data Wallet = Wallet - { wallet'deposit :: Integer - , wallet'collateral :: Integer - , wallet'borrow :: Integer + { wallet'deposit :: !Integer + , wallet'collateral :: !Integer + , wallet'borrow :: !Integer } deriving (Show) From 030ae9900196974a547231c0675458420917fe66 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 5 May 2021 11:53:28 +0300 Subject: [PATCH 15/81] Implements repay and withdraw --- mlabs/src/Mlabs/Lending/Logic/App.hs | 2 +- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 32 +++++---- mlabs/src/Mlabs/Lending/Logic/React.hs | 80 ++++++++++++++++++++--- mlabs/src/Mlabs/Lending/Logic/State.hs | 5 ++ mlabs/src/Mlabs/Lending/Logic/Types.hs | 4 +- 5 files changed, 98 insertions(+), 25 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 8306507d9..e8f6eff9a 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -37,6 +37,6 @@ initApp :: [(Coin, Rational)] -> App initApp coins = App { app'pool = LendingPool (M.fromList (fmap (second initReserve) coins)) mempty , app'log = [] - , app'wallets = BchState M.empty + , app'wallets = BchState $ M.fromList [(Self, defaultBchWallet)] } diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs index a97928064..bc2dc1308 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -2,11 +2,12 @@ module Mlabs.Lending.Logic.Emulator( BchState(..) , BchWallet(..) + , defaultBchWallet , Resp(..) - , Move(..) , applyResp ) where +import Data.Maybe import Data.Map.Strict (Map) import Mlabs.Lending.Logic.Types @@ -18,24 +19,29 @@ newtype BchState = BchState (Map UserId BchWallet) -- " For simplicity wallet is a map of coins to balances. newtype BchWallet = BchWallet (Map Coin Integer) +defaultBchWallet :: BchWallet +defaultBchWallet = BchWallet mempty + -- | We can give money to vallets and take it from them data Resp - = MoveTo Move - --- | Moving funds -data Move = Move - { move'addr :: UserId -- where move happens - , move'coin :: Coin -- on which value - , move'amount :: Integer -- how many to add (can be negative) - } + = Move + { move'addr :: UserId -- where move happens + , move'coin :: Coin -- on which value + , move'amount :: Integer -- how many to add (can be negative) + } + -- ^ move coins on wallet + | Mint + { mint'coin :: Coin + , mint'amount :: Integer + } + -- ^ mint new coins for lending platform -- | Applies reponse to the blockchain state. applyResp :: Resp -> BchState -> BchState applyResp resp (BchState wallets) = BchState $ case resp of - MoveTo act -> moveTo act wallets + Move addr coin amount -> updateWallet addr coin amount wallets + Mint coin amount -> updateWallet Self coin amount wallets where - moveTo Move{..} m = updateWallet move'addr move'coin move'amount m - updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m - updateBalance coin amt (BchWallet bals) = BchWallet $ M.update (\x -> Just (x + amt)) coin bals + updateBalance coin amt (BchWallet bals) = BchWallet $ M.alter (\x -> Just ((fromMaybe 0 x) + amt)) coin bals diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index c45387617..eb90f36e8 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -12,6 +12,8 @@ import Mlabs.Lending.Logic.Emulator import Mlabs.Lending.Logic.State import Mlabs.Lending.Logic.Types +import qualified Data.Text as T + -- | State transition for lending pool. -- For a given action we update internal state of Lending pool and produce -- list of responses to simulate change of the balances @@ -21,6 +23,7 @@ react = \case PriceAct act -> priceAct act GovernAct act -> governAct act where + -- | User acts userAct uid = \case DepositAct{..} -> depositAct uid act'amount act'asset BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate @@ -31,10 +34,13 @@ react = \case FlashLoanAct -> flashLoanAct uid LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken + --------------------------------------------------- + -- deposit + -- TODO: ignores ratio of liquidity to borrowed totals depositAct uid amount asset = do modifyWalletAndReserve uid asset (Right . depositUser) - let move a b = MoveTo $ Move uid a b + let move a b = Move uid a b pure [ move asset (negate amount) , move (aToken asset) amount @@ -42,31 +48,34 @@ react = \case where depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } + --------------------------------------------------- + -- borrow + -- TODO: ignores rate strategy (stable vs variable), ratio of liquidity to borrowed totals, health-check -- For borrowing to be valid we check that -- * reserve has enough liquidity -- * user does not use collateral reserve to borrow (it's meaningless for the user) -- * user has enough collateral for the borrow borrowAct uid asset amount _rate = do - hasEnoughLiquidity asset amount + hasEnoughLiquidityToBorrow asset amount collateralNonBorrow uid asset hasEnoughCollateral uid asset amount updateOnBorrow - pure [ MoveTo $ Move uid asset amount ] + pure [ Move uid asset amount ] where updateOnBorrow = modifyWalletAndReserve uid asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w - amount , wallet'borrow = wallet'borrow w + amount } - hasEnoughLiquidity asset amount = do + hasEnoughLiquidityToBorrow asset amount = do liquidity <- getsReserve asset (wallet'deposit . reserve'wallet) guardError ("Not enough liquidity for asset " <> showt asset) (liquidity >= amount) collateralNonBorrow uid asset = do col <- getsWallet uid asset wallet'collateral - guardError ("Collateral can not be used as borrow for user " <> showt uid <> " for asset " <> showt asset) + guardError (T.unwords ["Collateral can not be used as borrow for user", showt uid, "for asset", showt asset]) (col == 0) hasEnoughCollateral uid asset amount = do @@ -74,12 +83,29 @@ react = \case isOk <- getHealthCheck bor asset =<< getUser uid guardError msg isOk where - msg = mconcat [ "Not enough collateral to borrow ", showt amount, " ", showt asset, " for user ", showt uid] + msg = T.unwords ["Not enough collateral to borrow", showt amount, showt asset, "for user", showt uid] + + --------------------------------------------------- + -- repay (also called redeem in whitepaper) + repayAct uid asset amount _rate = do + bor <- getsWallet uid asset wallet'borrow + let newBor = bor - amount + if newBor >= 0 + then modifyWallet uid asset $ \w -> Right $ w { wallet'borrow = newBor } + else modifyWallet uid asset $ \w -> Right $ w { wallet'borrow = 0 + , wallet'deposit = abs newBor } + modifyReserveWallet asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w + amount } + pure [ Move uid asset (negate amount) ] + + --------------------------------------------------- + -- swap borrow model - repayAct _ _ _ _ = todo swapBorrowRateModelAct _ _ _ = todo + --------------------------------------------------- + -- set user reserve as collateral + setUserReserveAsCollateralAct uid asset useAsCollateral portion | useAsCollateral = setAsCollateral uid asset portion | otherwise = setAsDeposit uid asset portion @@ -92,7 +118,7 @@ react = \case { wallet'deposit = wallet'deposit w - amount , wallet'collateral = wallet'collateral w + amount } - pure [ MoveTo $ Move uid (aToken asset) (negate amount) ] + pure [ Move uid (aToken asset) (negate amount) ] setAsDeposit uid asset portion | portion <= 0 = pure [] @@ -102,27 +128,61 @@ react = \case { wallet'deposit = wallet'deposit w + amount , wallet'collateral = wallet'collateral w - amount } - pure [ MoveTo $ Move uid (aToken asset) amount ] + pure [ Move uid (aToken asset) amount ] getAmountBy extract uid asset portion = do val <- getsWallet uid asset extract pure $ floor $ portion * fromInteger val + --------------------------------------------------- + -- withdraw + + withdrawAct uid amount asset = do + -- validate withdraw + hasEnoughDepositToWithdraw uid amount asset + -- update state on withdraw + modifyWalletAndReserve uid asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w - amount } + let move a b = Move uid a b + pure [ move (aToken asset) (negate amount), move asset amount ] + + hasEnoughDepositToWithdraw uid amount asset = do + dep <- getsWallet uid asset wallet'deposit + guardError (T.unwords ["Not enough deposit to withdraw", showt amount, showt asset, "for user", showt uid]) + (dep >= amount) + + --------------------------------------------------- + -- flash loan - withdrawAct _ _ _ = todo flashLoanAct _ = todo + + --------------------------------------------------- + -- liquidation call + liquidationCallAct _ _ _ _ _ _ = todo + --------------------------------------------------- priceAct = \case SetAssetPrice coin rate -> setAssetPrice coin rate SetOracleAddr coin addr -> setOracleAddr coin addr + --------------------------------------------------- + -- update on market price change setAssetPrice _ _ = todo + + --------------------------------------------------- + -- set oracle address + -- setOracleAddr _ _ = todo + --------------------------------------------------- + -- Govern acts + governAct = \case AddReserve coin val -> addReserve coin val + --------------------------------------------------- + -- Adds new reserve (new coin/asset) + addReserve coin val = do LendingPool reserves users <- get if M.member coin reserves diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 531b6c3a6..394c67df5 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -16,6 +16,7 @@ module Mlabs.Lending.Logic.State( , getHealth , getHealthCheck , modifyReserve + , modifyReserveWallet , modifyUser , modifyWallet , modifyWalletAndReserve @@ -131,6 +132,10 @@ modifyUser uid f = do modifyWalletAndReserve :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () modifyWalletAndReserve uid coin f = do modifyWallet uid coin f + modifyReserveWallet coin f + +modifyReserveWallet :: Coin -> (Wallet -> Either Text Wallet) -> St () +modifyReserveWallet coin f = modifyReserve coin $ \r -> fmap (\w -> r { reserve'wallet = w }) $ f $ reserve'wallet r modifyWallet :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 3bd7af8a1..de1cf97fe 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -38,7 +38,9 @@ import Data.ByteString (ByteString) newtype Addr = Addr Integer deriving (Show, Eq, Ord) -newtype UserId = UserId Integer +data UserId + = UserId Integer -- user address + | Self -- addres of the lending platform deriving (Show, Eq, Ord) -- | Lending pool is a list of reserves From a09f02de7920be662e8d99bd717c8c981a7e20aa Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 5 May 2021 12:13:40 +0300 Subject: [PATCH 16/81] Emulator actions refactoring --- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 18 +++++++++++++++- mlabs/src/Mlabs/Lending/Logic/React.hs | 25 ++++++++++++++--------- mlabs/src/Mlabs/Lending/Logic/State.hs | 1 + 3 files changed, 33 insertions(+), 11 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs index bc2dc1308..a3148df3c 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -5,6 +5,7 @@ module Mlabs.Lending.Logic.Emulator( , defaultBchWallet , Resp(..) , applyResp + , moveFromTo ) where import Data.Maybe @@ -22,7 +23,8 @@ newtype BchWallet = BchWallet (Map Coin Integer) defaultBchWallet :: BchWallet defaultBchWallet = BchWallet mempty --- | We can give money to vallets and take it from them +-- | We can give money to vallets and take it from them. +-- We can mint new aToken coins on lending platform and burn it. data Resp = Move { move'addr :: UserId -- where move happens @@ -35,12 +37,26 @@ data Resp , mint'amount :: Integer } -- ^ mint new coins for lending platform + | Burn + { mint'coin :: Coin + , mint'amount :: Integer + } + -- ^ burns coins for lending platform + + +-- | Moves from first user to second user +moveFromTo :: UserId -> UserId -> Coin -> Integer -> [Resp] +moveFromTo from to coin amount = + [ Move from coin (negate amount) + , Move to coin amount + ] -- | Applies reponse to the blockchain state. applyResp :: Resp -> BchState -> BchState applyResp resp (BchState wallets) = BchState $ case resp of Move addr coin amount -> updateWallet addr coin amount wallets Mint coin amount -> updateWallet Self coin amount wallets + Burn coin amount -> updateWallet Self coin (negate amount) wallets where updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m updateBalance coin amt (BchWallet bals) = BchWallet $ M.alter (\x -> Just ((fromMaybe 0 x) + amt)) coin bals diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index eb90f36e8..ed7427d5f 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -40,10 +40,10 @@ react = \case -- TODO: ignores ratio of liquidity to borrowed totals depositAct uid amount asset = do modifyWalletAndReserve uid asset (Right . depositUser) - let move a b = Move uid a b - pure - [ move asset (negate amount) - , move (aToken asset) amount + pure $ mconcat + [ pure $ Mint (aToken asset) amount + , moveFromTo Self uid (aToken asset) amount + , moveFromTo uid Self asset amount ] where depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } @@ -61,7 +61,7 @@ react = \case collateralNonBorrow uid asset hasEnoughCollateral uid asset amount updateOnBorrow - pure [ Move uid asset amount ] + pure $ moveFromTo Self uid asset amount where updateOnBorrow = modifyWalletAndReserve uid asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w - amount @@ -96,7 +96,7 @@ react = \case else modifyWallet uid asset $ \w -> Right $ w { wallet'borrow = 0 , wallet'deposit = abs newBor } modifyReserveWallet asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w + amount } - pure [ Move uid asset (negate amount) ] + pure $ moveFromTo uid Self asset amount --------------------------------------------------- -- swap borrow model @@ -118,7 +118,10 @@ react = \case { wallet'deposit = wallet'deposit w - amount , wallet'collateral = wallet'collateral w + amount } - pure [ Move uid (aToken asset) (negate amount) ] + pure $ mconcat + [ moveFromTo uid Self (aToken asset) amount + , pure $ Burn (aToken asset) amount + ] setAsDeposit uid asset portion | portion <= 0 = pure [] @@ -128,7 +131,7 @@ react = \case { wallet'deposit = wallet'deposit w + amount , wallet'collateral = wallet'collateral w - amount } - pure [ Move uid (aToken asset) amount ] + pure $ moveFromTo Self uid (aToken asset) amount getAmountBy extract uid asset portion = do val <- getsWallet uid asset extract @@ -142,8 +145,10 @@ react = \case hasEnoughDepositToWithdraw uid amount asset -- update state on withdraw modifyWalletAndReserve uid asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w - amount } - let move a b = Move uid a b - pure [ move (aToken asset) (negate amount), move asset amount ] + pure $ mconcat + [ moveFromTo uid Self (aToken asset) amount + , moveFromTo Self uid asset amount + ] hasEnoughDepositToWithdraw uid amount asset = do dep <- getsWallet uid asset wallet'deposit diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 394c67df5..c4de900f8 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -42,6 +42,7 @@ type Error = Text -- | State update of lending pool type St = StateT LendingPool (Either Error) + ---------------------------------------------------- -- common functions From 098aa5ad2bb858f83849345685bfb3f32ce0b683 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 6 May 2021 14:14:52 +0300 Subject: [PATCH 17/81] Adds tests for prototype --- mlabs/mlabs-plutus-use-cases.cabal | 8 +- mlabs/src/Mlabs/Lending/Logic/App.hs | 69 +++++++-- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 22 ++- mlabs/src/Mlabs/Lending/Logic/React.hs | 24 +-- mlabs/src/Mlabs/Lending/Logic/State.hs | 82 +++++++--- mlabs/src/Mlabs/Lending/Logic/Types.hs | 103 ++++++------ mlabs/test/Main.hs | 7 +- mlabs/test/Test/Lending/Logic.hs | 181 ++++++++++++++++++++++ 8 files changed, 388 insertions(+), 108 deletions(-) create mode 100644 mlabs/test/Test/Lending/Logic.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 326cb8f7b..f08c239ba 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -2,7 +2,7 @@ cabal-version: >=1.10 -- Initial package description 'mlabs-plutus-use-cases.cabal' generated by 'cabal init'. -- For further documentation, see http://haskell.org/cabal/users-guide/ -name: mlabs-plutus-use-caases +name: mlabs-plutus-use-cases version: 0.1.0.0 -- synopsis: -- description: @@ -62,9 +62,10 @@ library TemplateHaskell DataKinds TypeOperators + TupleSections LambdaCase -executable mlabs-plutus-use-caases +executable mlabs-plutus-use-cases main-is: Main.hs hs-source-dirs: app/ -- other-modules: @@ -93,14 +94,17 @@ Test-suite mlabs-plutus-use-cases-tests Default-Language: Haskell2010 Build-Depends: base >=4.9 && <5 , mlabs-plutus-use-cases + , containers , text , tasty , tasty-hunit hs-source-dirs: test Main-is: Main.hs Other-modules: Test.Lending + Test.Lending.Logic default-extensions: RecordWildCards OverloadedStrings QuasiQuotes + TupleSections diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index e8f6eff9a..9e14e48e8 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -1,8 +1,10 @@ --- | Ann lending app emulator +-- | Lending app emulator module Mlabs.Lending.Logic.App( App(..) , runApp - , initApp + , AppConfig(..) + , defaultAppConfig + , lookupAppWallet ) where import Prelude @@ -19,24 +21,67 @@ import Mlabs.Lending.Logic.State import qualified Data.Map.Strict as M +-- | Prototype application data App = App - { app'pool :: !LendingPool - , app'log :: ![Error] - , app'wallets :: !BchState + { app'pool :: !LendingPool -- ^ lending pool + , app'log :: ![Error] -- ^ error log + , app'wallets :: !BchState -- ^ current state of blockchain } -runApp :: App -> [Act] -> App -runApp app acts = foldl' go app acts +-- | Lookup state of the blockchain-wallet for a given user-id. +lookupAppWallet :: UserId -> App -> Maybe BchWallet +lookupAppWallet uid App{..} = case app'wallets of + BchState wals -> M.lookup uid wals + +-- | Runs application with the list of actions. +-- Returns final state of the application. +runApp :: AppConfig -> [Act] -> App +runApp cfg acts = foldl' go (initApp cfg) acts where + -- There are two possible sources of errors: + -- * we can not make transition to state (react produces Left) + -- * the transition produces action on blockchain that leads to negative balances (applyResp produces Left) go (App lp errs wallets) act = case runStateT (react act) lp of - Right (resp, nextState) -> App nextState errs (foldl' (flip applyResp) wallets resp) + Right (resp, nextState) -> case foldM (flip applyResp) wallets resp of + Right nextWallets -> App nextState errs nextWallets + Left err -> App lp (err : errs) wallets Left err -> App lp (err : errs) wallets +-- Configuration paprameters for app. +data AppConfig = AppConfig + { appConfig'reserves :: [(Coin, Rational)] + -- ^ coins with ratios to base currencies for each reserve + , appConfig'users :: [(UserId, BchWallet)] + -- ^ initial set of users with their wallets on blockchain + -- the wallet for lending app wil be created automatically. + -- no need to include it here + } + -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) -initApp :: [(Coin, Rational)] -> App -initApp coins = App - { app'pool = LendingPool (M.fromList (fmap (second initReserve) coins)) mempty +initApp :: AppConfig -> App +initApp AppConfig{..} = App + { app'pool = LendingPool (M.fromList (fmap (second initReserve) appConfig'reserves)) mempty , app'log = [] - , app'wallets = BchState $ M.fromList [(Self, defaultBchWallet)] + , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users } +-- | Default application. +-- It allocates three users nad three reserves for Dollars, Euros and Liras. +-- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. +defaultAppConfig :: AppConfig +defaultAppConfig = AppConfig reserves users + where + reserves = fmap (, 1) [coin1, coin2, coin3] + + coin1 = Coin "Dollar" + coin2 = Coin "Euro" + coin3 = Coin "Lira" + + users = [user1, user2, user3] + + user1 = (UserId 1, wal (coin1, 100)) + user2 = (UserId 2, wal (coin2, 100)) + user3 = (UserId 3, wal (coin3, 100)) + + wal cs = BchWallet $ uncurry M.singleton cs + diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs index a3148df3c..b1559d81d 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -10,6 +10,8 @@ module Mlabs.Lending.Logic.Emulator( import Data.Maybe import Data.Map.Strict (Map) +import Data.Text + import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M @@ -19,7 +21,9 @@ newtype BchState = BchState (Map UserId BchWallet) -- " For simplicity wallet is a map of coins to balances. newtype BchWallet = BchWallet (Map Coin Integer) + deriving (Show, Eq, Ord) +-- | Default empty wallet defaultBchWallet :: BchWallet defaultBchWallet = BchWallet mempty @@ -42,7 +46,7 @@ data Resp , mint'amount :: Integer } -- ^ burns coins for lending platform - + deriving (Show) -- | Moves from first user to second user moveFromTo :: UserId -> UserId -> Coin -> Integer -> [Resp] @@ -52,12 +56,20 @@ moveFromTo from to coin amount = ] -- | Applies reponse to the blockchain state. -applyResp :: Resp -> BchState -> BchState -applyResp resp (BchState wallets) = BchState $ case resp of +applyResp :: Resp -> BchState -> Either Text BchState +applyResp resp (BchState wallets) = fmap BchState $ case resp of Move addr coin amount -> updateWallet addr coin amount wallets Mint coin amount -> updateWallet Self coin amount wallets Burn coin amount -> updateWallet Self coin (negate amount) wallets where - updateWallet addr coin amt m = M.update (Just . updateBalance coin amt) addr m - updateBalance coin amt (BchWallet bals) = BchWallet $ M.alter (\x -> Just ((fromMaybe 0 x) + amt)) coin bals + updateWallet addr coin amt m = M.alterF (maybe (pure Nothing) (fmap Just . updateBalance coin amt)) addr m + + updateBalance :: Coin -> Integer -> BchWallet -> Either Text BchWallet + updateBalance coin amt (BchWallet bals) = fmap BchWallet $ M.alterF (upd amt) coin bals + + upd amt x + | res >= 0 = Right $ Just res + | otherwise = Left $ "Negative balance for " <> showt resp + where + res = fromMaybe 0 x + amt diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index ed7427d5f..97186ece7 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -14,9 +14,9 @@ import Mlabs.Lending.Logic.Types import qualified Data.Text as T --- | State transition for lending pool. +-- | State transitions for lending pool. -- For a given action we update internal state of Lending pool and produce --- list of responses to simulate change of the balances +-- list of responses to simulate change of the balances on blockchain. react :: Act -> St [Resp] react = \case UserAct uid act -> userAct uid act @@ -39,14 +39,14 @@ react = \case -- TODO: ignores ratio of liquidity to borrowed totals depositAct uid amount asset = do - modifyWalletAndReserve uid asset (Right . depositUser) + modifyWalletAndReserve uid asset depositUser pure $ mconcat [ pure $ Mint (aToken asset) amount , moveFromTo Self uid (aToken asset) amount , moveFromTo uid Self asset amount ] where - depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } + depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } --------------------------------------------------- -- borrow @@ -63,7 +63,7 @@ react = \case updateOnBorrow pure $ moveFromTo Self uid asset amount where - updateOnBorrow = modifyWalletAndReserve uid asset $ \w -> Right $ w + updateOnBorrow = modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount , wallet'borrow = wallet'borrow w + amount } @@ -92,10 +92,10 @@ react = \case bor <- getsWallet uid asset wallet'borrow let newBor = bor - amount if newBor >= 0 - then modifyWallet uid asset $ \w -> Right $ w { wallet'borrow = newBor } - else modifyWallet uid asset $ \w -> Right $ w { wallet'borrow = 0 - , wallet'deposit = abs newBor } - modifyReserveWallet asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w + amount } + then modifyWallet uid asset $ \w -> w { wallet'borrow = newBor } + else modifyWallet uid asset $ \w -> w { wallet'borrow = 0 + , wallet'deposit = abs newBor } + modifyReserveWallet asset $ \w -> w { wallet'deposit = wallet'deposit w + amount } pure $ moveFromTo uid Self asset amount --------------------------------------------------- @@ -114,7 +114,7 @@ react = \case | portion <= 0 = pure [] | otherwise = do amount <- getAmountBy wallet'deposit uid asset portion - modifyWalletAndReserve uid asset $ \w -> Right $ w + modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount , wallet'collateral = wallet'collateral w + amount } @@ -127,7 +127,7 @@ react = \case | portion <= 0 = pure [] | otherwise = do amount <- getAmountBy wallet'collateral uid asset portion - modifyWalletAndReserve uid asset $ \w -> Right $ w + modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w + amount , wallet'collateral = wallet'collateral w - amount } @@ -144,7 +144,7 @@ react = \case -- validate withdraw hasEnoughDepositToWithdraw uid amount asset -- update state on withdraw - modifyWalletAndReserve uid asset $ \w -> Right $ w { wallet'deposit = wallet'deposit w - amount } + modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount } pure $ mconcat [ moveFromTo uid Self (aToken asset) amount , moveFromTo Self uid asset amount diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index c4de900f8..8de0112b4 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -20,6 +20,11 @@ module Mlabs.Lending.Logic.State( , modifyUser , modifyWallet , modifyWalletAndReserve + , modifyReserve' + , modifyReserveWallet' + , modifyUser' + , modifyWallet' + , modifyWalletAndReserve' ) where import Prelude @@ -32,41 +37,46 @@ import Data.Text import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M -import qualified Data.Text as T - -showt :: Show a => a -> Text -showt = T.pack . show +-- | Type for errors type Error = Text -- | State update of lending pool type St = StateT LendingPool (Either Error) - ---------------------------------------------------- -- common functions +-- | Execute further if condition is True or throw error with +-- given error message. guardError :: Text -> Bool -> St () guardError msg isTrue | isTrue = pure () | otherwise = throwError msg +-- | Read field from the internal wallet for user and on asset. +-- If there is no wallet empty wallet is allocated. getsWallet :: UserId -> Coin -> (Wallet -> a) -> St a getsWallet uid coin f = fmap f $ getWallet uid coin +-- | Get internal wallet for user on given asset. getWallet :: UserId -> Coin -> St Wallet getWallet uid coin = getsUser uid (fromMaybe defaultWallet . M.lookup coin . user'wallets) +-- | Get user info in the lending app by user id and apply extractor function to it. getsUser :: UserId -> (User -> a) -> St a getsUser uid f = fmap f $ getUser uid +-- | Get user info in the lending app by user id. getUser :: UserId -> St User getUser uid = gets (fromMaybe defaultUser . M.lookup uid . lp'users) +-- | Read reserve for a given asset and apply extractor function to it. getsReserve :: Coin -> (Reserve -> a) -> St a getsReserve coin extract = fmap extract $ getReserve coin +-- | Read reserve for a given asset. getReserve :: Coin -> St Reserve getReserve coin = do mReserve <- gets (M.lookup coin . lp'reserves) @@ -100,8 +110,10 @@ getTotalBorrow = walletTotal wallet'borrow getTotalDeposit :: User -> St Integer getTotalDeposit = walletTotal wallet'deposit +-- | Check that user has enough health for the given asset. getHealthCheck :: Integer -> Coin -> User -> St Bool -getHealthCheck addToBorrow coin user = fmap (> 1) $ getHealth addToBorrow coin user +getHealthCheck addToBorrow coin user = + fmap (> 1) $ getHealth addToBorrow coin user -- | Check borrowing health for the user by given currency getHealth :: Integer -> Coin -> User -> St Rational @@ -111,36 +123,62 @@ getHealth addToBorrow coin user = do liq <- getLiquidationThreshold coin pure $ fromInteger col * liq / fromInteger bor +-- | Reads liquidation threshold for a give asset. getLiquidationThreshold :: Coin -> St Rational getLiquidationThreshold coin = gets (maybe 0 reserve'liquidationThreshold . M.lookup coin . lp'reserves) -modifyReserve :: Coin -> (Reserve -> Either Text Reserve) -> St () -modifyReserve asset f = do +-- | Modify reserve for a given asset. +modifyReserve :: Coin -> (Reserve -> Reserve) -> St () +modifyReserve coin f = modifyReserve' coin (Right . f) + +-- | Modify reserve for a given asset. It can throw errors. +modifyReserve' :: Coin -> (Reserve -> Either Text Reserve) -> St () +modifyReserve' asset f = do LendingPool lp users <- get case M.lookup asset lp of Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users) (f reserve) Nothing -> throwError $ mconcat ["Asset is not supported: ", showt asset] -modifyUser :: UserId -> (User -> Either Text User) -> St () -modifyUser uid f = do +-- | Modify user info by id. +modifyUser :: UserId -> (User -> User) -> St () +modifyUser uid f = modifyUser' uid (Right . f) + +-- | Modify user info by id. It can throw errors. +modifyUser' :: UserId -> (User -> Either Text User) -> St () +modifyUser' uid f = do LendingPool lp users <- get case f $ fromMaybe defaultUser $ M.lookup uid users of Left msg -> throwError msg Right user -> put $ LendingPool lp (M.insert uid user users) --- | Applies the same modification function to the user and to the reserve wallet. -modifyWalletAndReserve :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () -modifyWalletAndReserve uid coin f = do - modifyWallet uid coin f - modifyReserveWallet coin f - -modifyReserveWallet :: Coin -> (Wallet -> Either Text Wallet) -> St () -modifyReserveWallet coin f = - modifyReserve coin $ \r -> fmap (\w -> r { reserve'wallet = w }) $ f $ reserve'wallet r - -modifyWallet :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () -modifyWallet uid coin f = modifyUser uid $ \(User ws) -> do +-- | Modify user wallet and reserve wallet with the same function. +modifyWalletAndReserve :: UserId -> Coin -> (Wallet -> Wallet) -> St () +modifyWalletAndReserve uid coin f = modifyWalletAndReserve' uid coin (Right . f) + +-- | Applies the same modification function to the user and to the reserve wallet. It can throw errors. +modifyWalletAndReserve' :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () +modifyWalletAndReserve' uid coin f = do + modifyWallet' uid coin f + modifyReserveWallet' coin f + +-- | Modify reserve wallet for a given asset. +modifyReserveWallet :: Coin -> (Wallet -> Wallet) -> St () +modifyReserveWallet coin f = modifyReserveWallet' coin (Right . f) + +-- | Modify reserve wallet for a given asset. It can throw errors. +modifyReserveWallet' :: Coin -> (Wallet -> Either Text Wallet) -> St () +modifyReserveWallet' coin f = + modifyReserve' coin $ \r -> fmap (\w -> r { reserve'wallet = w }) $ f $ reserve'wallet r + +-- | Modify internal user wallet that is allocated for a given user id and asset. +modifyWallet :: UserId -> Coin -> (Wallet -> Wallet) -> St () +modifyWallet uid coin f = modifyWallet' uid coin (Right . f) + +-- | Modify internal user wallet that is allocated for a given user id and asset. +-- It can throw errors. +modifyWallet' :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () +modifyWallet' uid coin f = modifyUser' uid $ \(User ws) -> do wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws pure $ User $ M.insert coin wal ws diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index de1cf97fe..c5c441e7e 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -11,33 +11,34 @@ module Mlabs.Lending.Logic.Types( , defaultUser , UserId(..) , Reserve(..) + , InterestRate(..) , initReserve , Act(..) , UserAct(..) - , PriceQuery(..) , PriceAct(..) , GovernAct(..) , LpAddressesProvider(..) , LpAddressesProviderRegistry(..) , Coin(..) , aToken - , Addr(..) , LpCollateralManager(..) , LpConfigurator(..) , PriceOracleProvider(..) , InterestRateStrategy(..) - , Collateral(..) - , Deposit(..) + , showt ) where import Prelude +import Data.Text import Data.Map.Strict (Map) import Data.ByteString (ByteString) +import qualified Data.Text as T --- | Address that can hold values of assets -newtype Addr = Addr Integer - deriving (Show, Eq, Ord) +-- | Helper to print @Text@ values +showt :: Show a => a -> Text +showt = T.pack . show +-- | Address of the wallet that can hold values of assets data UserId = UserId Integer -- user address | Self -- addres of the lending platform @@ -45,8 +46,8 @@ data UserId -- | Lending pool is a list of reserves data LendingPool = LendingPool - { lp'reserves :: !(Map Coin Reserve) - , lp'users :: !(Map UserId User) + { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves + , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app } deriving (Show) @@ -71,49 +72,34 @@ initReserve rate = Reserve , reserve'liquidationThreshold = 0.8 } +-- | User is a set of wallets per currency data User = User { user'wallets :: !(Map Coin Wallet) } deriving (Show) +-- | Default user with no wallets. defaultUser :: User defaultUser = User mempty +-- | Internal walet of the lending app +-- +-- All amounts are provided in the currency of the wallet data Wallet = Wallet - { wallet'deposit :: !Integer - , wallet'collateral :: !Integer - , wallet'borrow :: !Integer + { wallet'deposit :: !Integer -- ^ amount of deposit + , wallet'collateral :: !Integer -- ^ amount of collateral + , wallet'borrow :: !Integer -- ^ amount of borrow } deriving (Show) defaultWallet :: Wallet defaultWallet = Wallet 0 0 0 -data UserConfig = UserConfig - { userConfig'collaterals :: [Addr] - , userConfig'borrows :: [Borrow] - } - deriving (Show) - -data Borrow = Borrow - { borrow'amount :: Integer - , borrow'health :: Rational - } - deriving (Show) - --- | Colateral -data Collateral = Collateral - { collateral'amount :: Integer - } - deriving (Show) - --- | Deposit -data Deposit = Deposit - { deposit'amount :: Integer - } - deriving (Show) - -data Act = UserAct UserId UserAct | PriceAct PriceAct | GovernAct GovernAct +-- | Acts for lending platform +data Act + = UserAct UserId UserAct -- ^ user's actions + | PriceAct PriceAct -- ^ price oracle's actions + | GovernAct GovernAct -- ^ app admin's actions deriving (Show) -- | Lending pool action @@ -122,59 +108,59 @@ data UserAct { act'amount :: Integer , act'asset :: Coin } + -- ^ deposit funds | BorrowAct { act'asset :: Coin , act'amount :: Integer , act'rate :: InterestRate } + -- ^ borrow funds. We have to allocate collateral to be able to borrow | RepayAct { act'asset :: Coin , act'amount :: Integer , act'rate :: InterestRate } + -- ^ repay part of the borrow | SwapBorrowRateModelAct { act'asset :: Coin , act'rate :: InterestRate } + -- ^ swap borrow interest rate strategy (stable to variable) | SetUserReserveAsCollateralAct { act'asset :: Coin -- ^ which asset to use as collateral or not , act'useAsCollateral :: Bool -- ^ should we use as collateral (True) or use as deposit (False) , act'portion :: Rational -- ^ poriton of deposit/collateral to change status (0, 1) } + -- ^ set some portion of deposit as collateral or some portion of collateral as deposit | WithdrawAct { act'amount :: Integer , act'asset :: Coin } + -- ^ withdraw funds from deposit | FlashLoanAct -- TODO + -- ^ flash loans happen within the single block of transactions | LiquidationCallAct - { act'collateral :: Addr -- ^ collateral address - , act'debt :: Addr - , act'user :: Addr + { act'collateral :: UserId -- ^ collateral address + , act'debt :: UserId + , act'user :: UserId , act'debtToCover :: Integer , act'receiveAToken :: Bool } + -- ^ call to liquidate borrows that are unsafe due to health check deriving (Show) -data PriceQuery - = GetAssetPrice Coin - | GetAssetPrices [Coin] - | GetOracleAddr Coin - deriving (Show) - +-- | Acts that can be done by admin users. data GovernAct - = AddReserve Coin Rational + = AddReserve Coin Rational -- ^ Adds new reserve deriving (Show) +-- | Updates for the prices of the currencies on the markets data PriceAct - = SetAssetPrice Coin Rational - | SetOracleAddr Coin Addr + = SetAssetPrice Coin Rational -- ^ Set asset price + | SetOracleAddr Coin UserId -- ^ Provide address of the oracle deriving (Show) -data LpAddressesProvider = LpAddressesProvider - -newtype LpAddressesProviderRegistry - = LpAddressesProviderRegistry [LpAddressesProvider] - +-- | Custom currency newtype Coin = Coin ByteString deriving (Show, Eq, Ord) @@ -182,6 +168,15 @@ newtype Coin = Coin ByteString aToken :: Coin -> Coin aToken (Coin bs) = Coin $ "a" <> bs +---------------------------------------------------- +-- some types specific to aave +-- + +data LpAddressesProvider = LpAddressesProvider + +newtype LpAddressesProviderRegistry + = LpAddressesProviderRegistry [LpAddressesProvider] + data LpCollateralManager = LpCollateralManager data LpConfigurator = LpConfigurator diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index d82a4bd93..8d539f64a 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -1,4 +1,9 @@ module Main where +import Test.Tasty + +import qualified Test.Lending.Logic as Logic + main :: IO () -main = return () +main = defaultMain $ Logic.test + diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs new file mode 100644 index 000000000..bd844d64e --- /dev/null +++ b/mlabs/test/Test/Lending/Logic.hs @@ -0,0 +1,181 @@ +-- | Tests for logic of state transitions for aave prototype +module Test.Lending.Logic( + test + , testScript +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Mlabs.Lending.Logic.App +import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.Types + +import qualified Data.Map.Strict as M + +noErrors :: App -> Bool +noErrors app = null $ app'log app + +-- | Test suite for a logic of lending application +test :: TestTree +test = testGroup "User actions" + [ testCase "Deposit" testDeposit + , testCase "Borrow" testBorrow + , testCase "Borrow without collateral" testBorrowNoCollateral + , testCase "Borrow with not enough collateral" testBorrowNotEnoughCollateral + , testCase "Withdraw" testWithdraw + , testCase "Repay" testRepay + ] + where + testBorrow = testWallets [(user1, w1)] borrowScript + where + w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 30), (aToken coin1, 0)] + + testDeposit = testWallets [(user1, wal coin1), (user2, wal coin2), (user3, wal coin3)] depositScript + where + wal coin = BchWallet $ M.fromList [(coin, 50), (aToken coin, 50)] + + testBorrowNoCollateral = testScript borrowNoCollateralScript @=? False + testBorrowNotEnoughCollateral = testScript borrowNotEnoughCollateralScript @=? False + + testWithdraw = testWallets [(user1, w1)] withdrawScript + where + w1 = BchWallet $ M.fromList [(coin1, 75), (aToken coin1, 25)] + + -- User: + -- * deposits 50 coin1 + -- * sets it all as collateral + -- * borrows 30 coin2 + -- * repays 20 coin2 back + -- + -- So we get: + -- coin1 - 50 + -- coin2 - 10 = 30 - 20 + -- aToken - 0 = remaining from collateral + testRepay = testWallets [(user1, w1)] repayScript + where + w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 10), (aToken coin1, 0)] + +-- | Checks that script runs without errors +testScript :: [Act] -> Bool +testScript script = noErrors $ runApp testAppConfig script + +-- | Check that we have those wallets after script was run. +testWallets :: [(UserId, BchWallet)] -> [Act] -> Assertion +testWallets wals script = do + assertBool "Script has no errors" $ noErrors app + mapM_ (uncurry $ hasWallet app) wals + where + app = runApp testAppConfig script + +-- | Checks that application state contains concrete wallet for a given user id. +hasWallet :: App -> UserId -> BchWallet -> Assertion +hasWallet app uid wal = lookupAppWallet uid app @=? Just wal + +-- | 3 users deposit 50 coins to lending app +depositScript :: [Act] +depositScript = + [ UserAct user1 $ DepositAct 50 coin1 + , UserAct user2 $ DepositAct 50 coin2 + , UserAct user3 $ DepositAct 50 coin3 + ] + +-- | 3 users deposit 50 coins to lending app +-- and first user borrows in coin2 that he does not own prior to script run. +borrowScript :: [Act] +borrowScript = mconcat + [ depositScript + , [ UserAct user1 $ SetUserReserveAsCollateralAct + { act'asset = coin1 + , act'useAsCollateral = True + , act'portion = 1 + } + , UserAct user1 $ BorrowAct + { act'asset = coin2 + , act'amount = 30 + , act'rate = StableRate + } + ] + ] + +-- | Try to borrow without setting up deposit as collateral. +borrowNoCollateralScript :: [Act] +borrowNoCollateralScript = mconcat + [ depositScript + , pure $ UserAct user1 $ BorrowAct + { act'asset = coin2 + , act'amount = 30 + , act'rate = StableRate + } + ] + +-- | Try to borrow more than collateral permits +borrowNotEnoughCollateralScript :: [Act] +borrowNotEnoughCollateralScript = mconcat + [ depositScript + , [ UserAct user1 $ SetUserReserveAsCollateralAct + { act'asset = coin1 + , act'useAsCollateral = True + , act'portion = 1 + } + , UserAct user1 $ BorrowAct + { act'asset = coin2 + , act'amount = 60 + , act'rate = StableRate + } + ] + ] + +-- | User1 deposits 50 out of 100 and gets back 25. +-- So we check that user has 75 coins and 25 aCoins +withdrawScript :: [Act] +withdrawScript = mconcat + [ depositScript + , pure $ UserAct user1 $ WithdrawAct + { act'amount = 25 + , act'asset = coin1 + } + ] + +-- | We use borrow script to deposit and borrow for user 1 +-- and then repay part of the borrow. +repayScript :: [Act] +repayScript = mconcat + [ borrowScript + , pure $ UserAct user1 $ RepayAct + { act'asset = coin2 + , act'amount = 20 + , act'rate = StableRate + } + ] + +--------------------------------- +-- constants + +-- users +user1, user2, user3 :: UserId +user1 = UserId 1 +user2 = UserId 2 +user3 = UserId 3 + +-- coins +coin1, coin2, coin3 :: Coin +coin1 = Coin "Dollar" +coin2 = Coin "Euro" +coin3 = Coin "Lira" + +-- | Default application. +-- It allocates three users nad three reserves for Dollars, Euros and Liras. +-- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. +testAppConfig :: AppConfig +testAppConfig = AppConfig reserves users + where + reserves = fmap (, 1) [coin1, coin2, coin3] + users = + [ (user1, wal (coin1, 100)) + , (user2, wal (coin2, 100)) + , (user3, wal (coin3, 100)) + ] + + wal cs = BchWallet $ uncurry M.singleton cs + From d8a0ecc5a3653d9e05a9c7ce44b23aea58bb3563 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 6 May 2021 19:35:37 +0300 Subject: [PATCH 18/81] Pltusify core types for aave --- mlabs/mlabs-plutus-use-cases.cabal | 3 + mlabs/src/Mlabs/Lending/Lendex.hs | 44 +++++++++++++ mlabs/src/Mlabs/Lending/Logic/App.hs | 10 +-- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 16 ++--- mlabs/src/Mlabs/Lending/Logic/React.hs | 34 +++++----- mlabs/src/Mlabs/Lending/Logic/State.hs | 75 +++++++++++++++++------ mlabs/src/Mlabs/Lending/Logic/Types.hs | 70 +++++++++++++++------ 7 files changed, 187 insertions(+), 65 deletions(-) create mode 100644 mlabs/src/Mlabs/Lending/Lendex.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 1e5ccdd37..a437b5b69 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -44,6 +44,7 @@ library exposed-modules: Mlabs.Lending Mlabs.Lending.Coin + Mlabs.Lending.Lendex Mlabs.Lending.Logic.App Mlabs.Lending.Logic.Emulator Mlabs.Lending.Logic.React @@ -75,6 +76,8 @@ library DataKinds TypeOperators TypeApplications + FlexibleInstances + TypeSynonymInstances TupleSections executable mlabs-plutus-use-cases diff --git a/mlabs/src/Mlabs/Lending/Lendex.hs b/mlabs/src/Mlabs/Lending/Lendex.hs new file mode 100644 index 000000000..31675d8cc --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Lendex.hs @@ -0,0 +1,44 @@ +module Mlabs.Lending.Lendex( + +) where + +import qualified Prelude +import Control.Monad.State.Strict (runStateT) + +import qualified Plutus.Contract.StateMachine as SM +import qualified Ledger.Typed.Scripts as Scripts +import qualified PlutusTx as PlutusTx +import PlutusTx.Prelude hiding (Applicative (..), check) + +import Mlabs.Lending.Logic.React +import Mlabs.Lending.Logic.Types + +type Lendex = SM.StateMachine LendingPool Act + +{-# INLINABLE machine #-} +machine :: Lendex +machine = SM.mkStateMachine Nothing transition isFinal + where + isFinal = const False + +{-# INLINABLE mkValidator #-} +mkValidator :: Scripts.ValidatorType Lendex +mkValidator = SM.mkValidator machine + +scriptInstance :: Scripts.ScriptInstance Lendex +scriptInstance = Scripts.validator @Lendex + $$(PlutusTx.compile [|| mkValidator ||]) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator + +transition :: + SM.State LendingPool + -> Act + -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) +transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of + Left err -> Nothing + Right (_, newData) -> Just (mempty, SM.State { stateData=newData, stateValue=oldValue }) + + + diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 9e14e48e8..4e1a669b1 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -7,9 +7,9 @@ module Mlabs.Lending.Logic.App( , lookupAppWallet ) where -import Prelude +import PlutusTx.Prelude -import Control.Monad.State.Strict +import Control.Monad.State.Strict hiding (Functor(..)) import Control.Arrow (second) import Data.List (foldl') @@ -20,6 +20,8 @@ import Mlabs.Lending.Logic.Types import Mlabs.Lending.Logic.State import qualified Data.Map.Strict as M +import qualified PlutusTx.AssocMap as AM +import qualified PlutusTx.Ratio as R -- | Prototype application data App = App @@ -60,7 +62,7 @@ data AppConfig = AppConfig -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: AppConfig -> App initApp AppConfig{..} = App - { app'pool = LendingPool (M.fromList (fmap (second initReserve) appConfig'reserves)) mempty + { app'pool = LendingPool (AM.fromList (fmap (second initReserve) appConfig'reserves)) AM.empty , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users } @@ -71,7 +73,7 @@ initApp AppConfig{..} = App defaultAppConfig :: AppConfig defaultAppConfig = AppConfig reserves users where - reserves = fmap (, 1) [coin1, coin2, coin3] + reserves = fmap (, R.fromInteger 1) [coin1, coin2, coin3] coin1 = Coin "Dollar" coin2 = Coin "Euro" diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs index 507c17cbd..69f804aef 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -8,12 +8,11 @@ module Mlabs.Lending.Logic.Emulator( , moveFromTo ) where -import Prelude +import Prelude () +import PlutusTx.Prelude hiding (fromMaybe, maybe) import Data.Maybe import Data.Map.Strict (Map) -import Data.Text - import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M @@ -23,11 +22,14 @@ newtype BchState = BchState (Map UserId BchWallet) -- " For simplicity wallet is a map of coins to balances. newtype BchWallet = BchWallet (Map Coin Integer) - deriving (Show, Eq, Ord) + deriving newtype (Show) + +instance Eq BchWallet where + (BchWallet a) == (BchWallet b) = M.toList a == M.toList b -- | Default empty wallet defaultBchWallet :: BchWallet -defaultBchWallet = BchWallet mempty +defaultBchWallet = BchWallet M.empty -- | We can give money to vallets and take it from them. -- We can mint new aToken coins on lending platform and burn it. @@ -58,7 +60,7 @@ moveFromTo from to coin amount = ] -- | Applies reponse to the blockchain state. -applyResp :: Resp -> BchState -> Either Text BchState +applyResp :: Resp -> BchState -> Either String BchState applyResp resp (BchState wallets) = fmap BchState $ case resp of Move addr coin amount -> updateWallet addr coin amount wallets Mint coin amount -> updateWallet Self coin amount wallets @@ -66,7 +68,7 @@ applyResp resp (BchState wallets) = fmap BchState $ case resp of where updateWallet addr coin amt m = M.alterF (maybe (pure Nothing) (fmap Just . updateBalance coin amt)) addr m - updateBalance :: Coin -> Integer -> BchWallet -> Either Text BchWallet + updateBalance :: Coin -> Integer -> BchWallet -> Either String BchWallet updateBalance coin amt (BchWallet bals) = fmap BchWallet $ M.alterF (upd amt) coin bals upd amt x diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index e62677e3f..7e9aa3f4a 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -3,19 +3,19 @@ module Mlabs.Lending.Logic.React( react ) where -import Prelude +import qualified PlutusTx.Ratio as R +import qualified PlutusTx.Numeric as N +import PlutusTx.Prelude +import qualified PlutusTx.AssocMap as M import Control.Monad.Except import Control.Monad.State.Strict -import qualified Data.Map.Strict as M - import Mlabs.Lending.Logic.Emulator import Mlabs.Lending.Logic.State import Mlabs.Lending.Logic.Types -import qualified Data.Text as T - +{-# INLINABLE react #-} -- | State transitions for lending pool. -- For a given action we update internal state of Lending pool and produce -- list of responses to simulate change of the balances on blockchain. @@ -31,7 +31,7 @@ react = \case BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate RepayAct{..} -> repayAct uid act'asset act'amount act'rate SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate - SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion 1) + SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion (R.fromInteger 1)) WithdrawAct{..} -> withdrawAct uid act'amount act'asset FlashLoanAct -> flashLoanAct uid LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken @@ -43,7 +43,7 @@ react = \case depositAct uid amount asset = do modifyWalletAndReserve uid asset depositUser pure $ mconcat - [ pure $ Mint (aToken asset) amount + [ [Mint (aToken asset) amount] , moveFromTo Self uid (aToken asset) amount , moveFromTo uid Self asset amount ] @@ -77,7 +77,7 @@ react = \case collateralNonBorrow uid asset = do col <- getsWallet uid asset wallet'collateral - guardError (T.unwords ["Collateral can not be used as borrow for user", showt uid, "for asset", showt asset]) + guardError (mconcat ["Collateral can not be used as borrow for user ", showt uid, " for asset ", showt asset]) (col == 0) hasEnoughCollateral uid asset amount = do @@ -85,7 +85,7 @@ react = \case isOk <- getHealthCheck bor asset =<< getUser uid guardError msg isOk where - msg = T.unwords ["Not enough collateral to borrow", showt amount, showt asset, "for user", showt uid] + msg = mconcat ["Not enough collateral to borrow ", showt amount, " ", showt asset, " for user ", showt uid] --------------------------------------------------- -- repay (also called redeem in whitepaper) @@ -96,7 +96,7 @@ react = \case if newBor >= 0 then modifyWallet uid asset $ \w -> w { wallet'borrow = newBor } else modifyWallet uid asset $ \w -> w { wallet'borrow = 0 - , wallet'deposit = abs newBor } + , wallet'deposit = negate newBor } modifyReserveWallet asset $ \w -> w { wallet'deposit = wallet'deposit w + amount } pure $ moveFromTo uid Self asset amount @@ -113,8 +113,8 @@ react = \case | otherwise = setAsDeposit uid asset portion setAsCollateral uid asset portion - | portion <= 0 = pure [] - | otherwise = do + | portion <= R.fromInteger 0 = pure [] + | otherwise = do amount <- getAmountBy wallet'deposit uid asset portion modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount @@ -122,12 +122,12 @@ react = \case } pure $ mconcat [ moveFromTo uid Self (aToken asset) amount - , pure $ Burn (aToken asset) amount + , [Burn (aToken asset) amount] ] setAsDeposit uid asset portion - | portion <= 0 = pure [] - | otherwise = do + | portion <= R.fromInteger 0 = pure [] + | otherwise = do amount <- getAmountBy wallet'collateral uid asset portion modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w + amount @@ -137,7 +137,7 @@ react = \case getAmountBy extract uid asset portion = do val <- getsWallet uid asset extract - pure $ floor $ portion * fromInteger val + pure $ R.round $ portion N.* R.fromInteger val --------------------------------------------------- -- withdraw @@ -154,7 +154,7 @@ react = \case hasEnoughDepositToWithdraw uid amount asset = do dep <- getsWallet uid asset wallet'deposit - guardError (T.unwords ["Not enough deposit to withdraw", showt amount, showt asset, "for user", showt uid]) + guardError (mconcat ["Not enough deposit to withdraw ", showt amount, " ", showt asset, " for user ", showt uid]) (dep >= amount) --------------------------------------------------- diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 8de0112b4..d155389b6 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | State transitions for Lending app module Mlabs.Lending.Logic.State( St @@ -27,55 +28,74 @@ module Mlabs.Lending.Logic.State( , modifyWalletAndReserve' ) where -import Prelude +import qualified PlutusTx.Ratio as R +import qualified PlutusTx.Numeric as N +import PlutusTx.Prelude +import qualified PlutusTx.AssocMap as M -import Control.Monad.Except -import Control.Monad.State.Strict +import Control.Monad.Except hiding (Functor(..), mapM) +import Control.Monad.State.Strict hiding (Functor(..), mapM) -import Data.Maybe -import Data.Text import Mlabs.Lending.Logic.Types -import qualified Data.Map.Strict as M - -- | Type for errors -type Error = Text +type Error = String -- | State update of lending pool type St = StateT LendingPool (Either Error) +instance Functor St where + {-# INLINABLE fmap #-} + fmap f (StateT a) = StateT $ fmap (\(v, st) -> (f v, st)) . a + +instance Applicative St where + {-# INLINABLE pure #-} + pure a = StateT (\st -> Right (a, st)) + + {-# INLINABLE (<*>) #-} + (StateT f) <*> (StateT a) = StateT $ \st -> case f st of + Left err -> Left err + Right (f1, st1) -> fmap (\(a1, st2) -> (f1 a1, st2)) $ a st1 + ---------------------------------------------------- -- common functions +{-# INLINABLE guardError #-} -- | Execute further if condition is True or throw error with -- given error message. -guardError :: Text -> Bool -> St () +guardError :: Error -> Bool -> St () guardError msg isTrue | isTrue = pure () | otherwise = throwError msg +{-# INLINABLE getsWallet #-} -- | Read field from the internal wallet for user and on asset. -- If there is no wallet empty wallet is allocated. getsWallet :: UserId -> Coin -> (Wallet -> a) -> St a getsWallet uid coin f = fmap f $ getWallet uid coin -- | Get internal wallet for user on given asset. +{-# INLINABLE getWallet #-} getWallet :: UserId -> Coin -> St Wallet getWallet uid coin = getsUser uid (fromMaybe defaultWallet . M.lookup coin . user'wallets) +{-# INLINABLE getsUser #-} -- | Get user info in the lending app by user id and apply extractor function to it. getsUser :: UserId -> (User -> a) -> St a getsUser uid f = fmap f $ getUser uid +{-# INLINABLE getUser #-} -- | Get user info in the lending app by user id. getUser :: UserId -> St User getUser uid = gets (fromMaybe defaultUser . M.lookup uid . lp'users) +{-# INLINABLE getsReserve #-} -- | Read reserve for a given asset and apply extractor function to it. getsReserve :: Coin -> (Reserve -> a) -> St a getsReserve coin extract = fmap extract $ getReserve coin +{-# INLINABLE getReserve #-} -- | Read reserve for a given asset. getReserve :: Coin -> St Reserve getReserve coin = do @@ -84,100 +104,119 @@ getReserve coin = do where err = throwError $ "Uknown coin " <> showt coin +{-# INLINABLE toAda #-} -- | Convert given currency to base currency toAda :: Coin -> Integer -> St Integer toAda coin val = do ratio <- fmap reserve'rate $ getReserve coin - pure $ ceiling $ fromInteger val * ratio + pure $ R.round $ R.fromInteger val N.* ratio +{-# INLINABLE weightedTotal #-} -- | Weigted total of currencies in base currency weightedTotal :: [(Coin, Integer)] -> St Integer weightedTotal = fmap sum . mapM (uncurry toAda) +{-# INLINABLE walletTotal #-} -- | Collects cumulative value for given wallet field walletTotal :: (Wallet -> Integer) -> User -> St Integer walletTotal extract (User ws) = weightedTotal $ M.toList $ fmap extract ws +{-# INLINABLE getTotalCollateral #-} -- | Gets total collateral for a user. getTotalCollateral :: User -> St Integer getTotalCollateral = walletTotal wallet'collateral +{-# INLINABLE getTotalBorrow #-} -- | Gets total borrows for a user in base currency. getTotalBorrow :: User -> St Integer getTotalBorrow = walletTotal wallet'borrow +{-# INLINABLE getTotalDeposit #-} -- | Gets total deposit for a user in base currency. getTotalDeposit :: User -> St Integer getTotalDeposit = walletTotal wallet'deposit +{-# INLINABLE getHealthCheck #-} -- | Check that user has enough health for the given asset. getHealthCheck :: Integer -> Coin -> User -> St Bool getHealthCheck addToBorrow coin user = - fmap (> 1) $ getHealth addToBorrow coin user + fmap (> R.fromInteger 1) $ getHealth addToBorrow coin user +{-# INLINABLE getHealth #-} -- | Check borrowing health for the user by given currency getHealth :: Integer -> Coin -> User -> St Rational getHealth addToBorrow coin user = do col <- getTotalCollateral user bor <- fmap (+ addToBorrow) $ getTotalBorrow user liq <- getLiquidationThreshold coin - pure $ fromInteger col * liq / fromInteger bor + pure $ R.fromInteger col N.* liq N.* (R.recip $ R.fromInteger bor) +{-# INLINABLE getLiquidationThreshold #-} -- | Reads liquidation threshold for a give asset. getLiquidationThreshold :: Coin -> St Rational getLiquidationThreshold coin = - gets (maybe 0 reserve'liquidationThreshold . M.lookup coin . lp'reserves) + gets (maybe (R.fromInteger 0) reserve'liquidationThreshold . M.lookup coin . lp'reserves) +{-# INLINABLE modifyReserve #-} -- | Modify reserve for a given asset. modifyReserve :: Coin -> (Reserve -> Reserve) -> St () modifyReserve coin f = modifyReserve' coin (Right . f) +{-# INLINABLE modifyReserve' #-} -- | Modify reserve for a given asset. It can throw errors. -modifyReserve' :: Coin -> (Reserve -> Either Text Reserve) -> St () +modifyReserve' :: Coin -> (Reserve -> Either Error Reserve) -> St () modifyReserve' asset f = do LendingPool lp users <- get case M.lookup asset lp of Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users) (f reserve) Nothing -> throwError $ mconcat ["Asset is not supported: ", showt asset] +{-# INLINABLE modifyUser #-} -- | Modify user info by id. modifyUser :: UserId -> (User -> User) -> St () modifyUser uid f = modifyUser' uid (Right . f) +{-# INLINABLE modifyUser' #-} -- | Modify user info by id. It can throw errors. -modifyUser' :: UserId -> (User -> Either Text User) -> St () +modifyUser' :: UserId -> (User -> Either Error User) -> St () modifyUser' uid f = do LendingPool lp users <- get case f $ fromMaybe defaultUser $ M.lookup uid users of Left msg -> throwError msg Right user -> put $ LendingPool lp (M.insert uid user users) +{-# INLINABLE modifyWalletAndReserve #-} -- | Modify user wallet and reserve wallet with the same function. modifyWalletAndReserve :: UserId -> Coin -> (Wallet -> Wallet) -> St () modifyWalletAndReserve uid coin f = modifyWalletAndReserve' uid coin (Right . f) +{-# INLINABLE modifyWalletAndReserve' #-} -- | Applies the same modification function to the user and to the reserve wallet. It can throw errors. -modifyWalletAndReserve' :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () +modifyWalletAndReserve' :: UserId -> Coin -> (Wallet -> Either Error Wallet) -> St () modifyWalletAndReserve' uid coin f = do modifyWallet' uid coin f modifyReserveWallet' coin f +{-# INLINABLE modifyReserveWallet #-} -- | Modify reserve wallet for a given asset. modifyReserveWallet :: Coin -> (Wallet -> Wallet) -> St () modifyReserveWallet coin f = modifyReserveWallet' coin (Right . f) +{-# INLINABLE modifyReserveWallet' #-} -- | Modify reserve wallet for a given asset. It can throw errors. -modifyReserveWallet' :: Coin -> (Wallet -> Either Text Wallet) -> St () +modifyReserveWallet' :: Coin -> (Wallet -> Either Error Wallet) -> St () modifyReserveWallet' coin f = modifyReserve' coin $ \r -> fmap (\w -> r { reserve'wallet = w }) $ f $ reserve'wallet r +{-# INLINABLE modifyWallet #-} -- | Modify internal user wallet that is allocated for a given user id and asset. modifyWallet :: UserId -> Coin -> (Wallet -> Wallet) -> St () modifyWallet uid coin f = modifyWallet' uid coin (Right . f) +{-# INLINABLE modifyWallet' #-} -- | Modify internal user wallet that is allocated for a given user id and asset. -- It can throw errors. -modifyWallet' :: UserId -> Coin -> (Wallet -> Either Text Wallet) -> St () +modifyWallet' :: UserId -> Coin -> (Wallet -> Either Error Wallet) -> St () modifyWallet' uid coin f = modifyUser' uid $ \(User ws) -> do wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws pure $ User $ M.insert coin wal ws diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index c5c441e7e..16d30ff79 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -28,28 +28,38 @@ module Mlabs.Lending.Logic.Types( , showt ) where -import Prelude -import Data.Text -import Data.Map.Strict (Map) -import Data.ByteString (ByteString) -import qualified Data.Text as T +import qualified Prelude as P +import qualified PlutusTx as PlutusTx +import PlutusTx.Prelude +import PlutusTx.AssocMap (Map) +import qualified PlutusTx.AssocMap as M +import GHC.Generics +import Data.String + +{-# INLINABLE showt #-} -- | Helper to print @Text@ values -showt :: Show a => a -> Text -showt = T.pack . show +showt :: Show a => a -> String +showt = fromString . show -- | Address of the wallet that can hold values of assets data UserId = UserId Integer -- user address | Self -- addres of the lending platform - deriving (Show, Eq, Ord) + deriving (Show, Generic, P.Eq, P.Ord) + +instance Eq UserId where + {-# INLINABLE (==) #-} + Self == Self = True + UserId a == UserId b = a == b + _ == _ = False -- | Lending pool is a list of reserves data LendingPool = LendingPool { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app } - deriving (Show) + deriving (Show, Generic) -- | Reserve of give coin in the pool. -- It holds all info on individual collaterals and deposits. @@ -58,8 +68,9 @@ data Reserve = Reserve , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin } - deriving (Show) + deriving (Show, Generic) +{-# INLINABLE initReserve #-} -- | Initialise empty reserve with given ratio of its coin to ada initReserve :: Rational -> Reserve initReserve rate = Reserve @@ -69,18 +80,19 @@ initReserve rate = Reserve , wallet'collateral = 0 } , reserve'rate = rate - , reserve'liquidationThreshold = 0.8 + , reserve'liquidationThreshold = 8 % 10 } -- | User is a set of wallets per currency data User = User { user'wallets :: !(Map Coin Wallet) } - deriving (Show) + deriving (Show, Generic) +{-# INLINABLE defaultUser #-} -- | Default user with no wallets. defaultUser :: User -defaultUser = User mempty +defaultUser = User { user'wallets = M.empty } -- | Internal walet of the lending app -- @@ -90,8 +102,9 @@ data Wallet = Wallet , wallet'collateral :: !Integer -- ^ amount of collateral , wallet'borrow :: !Integer -- ^ amount of borrow } - deriving (Show) + deriving (Show, Generic) +{-# INLINABLE defaultWallet #-} defaultWallet :: Wallet defaultWallet = Wallet 0 0 0 @@ -100,7 +113,7 @@ data Act = UserAct UserId UserAct -- ^ user's actions | PriceAct PriceAct -- ^ price oracle's actions | GovernAct GovernAct -- ^ app admin's actions - deriving (Show) + deriving (Show, Generic) -- | Lending pool action data UserAct @@ -147,23 +160,28 @@ data UserAct , act'receiveAToken :: Bool } -- ^ call to liquidate borrows that are unsafe due to health check - deriving (Show) + deriving (Show, Generic) -- | Acts that can be done by admin users. data GovernAct = AddReserve Coin Rational -- ^ Adds new reserve - deriving (Show) + deriving (Show, Generic) -- | Updates for the prices of the currencies on the markets data PriceAct = SetAssetPrice Coin Rational -- ^ Set asset price | SetOracleAddr Coin UserId -- ^ Provide address of the oracle - deriving (Show) + deriving (Show, Generic) -- | Custom currency newtype Coin = Coin ByteString - deriving (Show, Eq, Ord) + deriving newtype (Show, P.Eq, P.Ord) + +instance Eq Coin where + {-# INLINABLE (==) #-} + Coin a == Coin b = a == b +{-# INLINABLE aToken #-} -- | Appends a prefix to all coins aToken :: Coin -> Coin aToken (Coin bs) = Coin $ "a" <> bs @@ -188,3 +206,17 @@ data InterestRateStrategy = InterestRateStrategy data InterestRate = StableRate | VariableRate deriving (Show) +------------------------------------------ + +PlutusTx.unstableMakeIsData ''InterestRate +PlutusTx.unstableMakeIsData ''Coin +PlutusTx.unstableMakeIsData ''UserAct +PlutusTx.unstableMakeIsData ''PriceAct +PlutusTx.unstableMakeIsData ''GovernAct +PlutusTx.unstableMakeIsData ''UserId +PlutusTx.unstableMakeIsData ''User +PlutusTx.unstableMakeIsData ''Wallet +PlutusTx.unstableMakeIsData ''Reserve +PlutusTx.unstableMakeIsData ''LendingPool +PlutusTx.unstableMakeIsData ''Act + From 74c4e9a8f2131136e70c1270af669048778c93d8 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 7 May 2021 12:54:27 +0300 Subject: [PATCH 19/81] Makes validation script compile to PlutusCore --- mlabs/src/Mlabs/Lending/Lendex.hs | 67 ++++++++++++++++++++++- mlabs/src/Mlabs/Lending/Logic/App.hs | 25 ++++++--- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 2 +- mlabs/src/Mlabs/Lending/Logic/React.hs | 44 ++++++++++----- mlabs/src/Mlabs/Lending/Logic/State.hs | 14 +++-- mlabs/src/Mlabs/Lending/Logic/Types.hs | 47 ++++++++-------- 6 files changed, 144 insertions(+), 55 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Lendex.hs b/mlabs/src/Mlabs/Lending/Lendex.hs index 31675d8cc..1ea1d0550 100644 --- a/mlabs/src/Mlabs/Lending/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Lendex.hs @@ -1,10 +1,18 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} module Mlabs.Lending.Lendex( - + userEndpoints + , mkValidator + , scriptInstance ) where -import qualified Prelude +import Control.Monad (forever) import Control.Monad.State.Strict (runStateT) +import Data.Functor (void) + +import Plutus.V1.Ledger.Contexts (pubKeyHash) +import Plutus.Contract import qualified Plutus.Contract.StateMachine as SM import qualified Ledger.Typed.Scripts as Scripts import qualified PlutusTx as PlutusTx @@ -25,6 +33,9 @@ machine = SM.mkStateMachine Nothing transition isFinal mkValidator :: Scripts.ValidatorType Lendex mkValidator = SM.mkValidator machine +client :: SM.StateMachineClient LendingPool Act +client = SM.mkStateMachineClient $ SM.StateMachineInstance machine scriptInstance + scriptInstance :: Scripts.ScriptInstance Lendex scriptInstance = Scripts.validator @Lendex $$(PlutusTx.compile [|| mkValidator ||]) @@ -32,13 +43,63 @@ scriptInstance = Scripts.validator @Lendex where wrap = Scripts.wrapValidator +{-# INLINABLE transition #-} transition :: SM.State LendingPool -> Act -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of - Left err -> Nothing + Left _ -> Nothing Right (_, newData) -> Just (mempty, SM.State { stateData=newData, stateValue=oldValue }) +type LendexError = SM.SMContractError + +type UserLendexSchema = + BlockchainActions + .\/ Endpoint "user-action" UserAct + +type UserApp a = Contract () UserLendexSchema LendexError a + +userAction :: UserAct -> UserApp () +userAction act = do + pkh <- fmap pubKeyHash ownPubKey + void $ SM.runStep client (UserAct (UserId pkh) act) + +-- | Endpoints for user +userEndpoints :: UserApp () +userEndpoints = forever userAction' + where + userAction' = endpoint @"user-action" >>= userAction + +type PriceOracleLendexSchema = + BlockchainActions + .\/ Endpoint "price-oracle-action" PriceAct +type PriceOracleApp a = Contract () PriceOracleLendexSchema LendexError a + +priceOracleAction :: PriceAct -> PriceOracleApp () +priceOracleAction act = do + void $ SM.runStep client (PriceAct act) + +-- | Endpoints for price oracle +priceOracleEndpoints :: PriceOracleApp () +priceOracleEndpoints = forever priceOracleAction' + where + priceOracleAction' = endpoint @"price-oracle-action" >>= priceOracleAction + +type GovernLendexSchema = + BlockchainActions + .\/ Endpoint "govern-action" GovernAct + +type GovernApp a = Contract () GovernLendexSchema LendexError a + +governAction :: GovernAct -> GovernApp () +governAction act = do + void $ SM.runStep client (GovernAct act) + +-- | Endpoints for admin user +governEndpoints :: GovernApp () +governEndpoints = forever governAction' + where + governAction' = endpoint @"govern-action" >>= governAction diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 4e1a669b1..2d64756cd 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -5,9 +5,12 @@ module Mlabs.Lending.Logic.App( , AppConfig(..) , defaultAppConfig , lookupAppWallet + , toCoin ) where import PlutusTx.Prelude +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) +import Plutus.V1.Ledger.Value import Control.Monad.State.Strict hiding (Functor(..)) import Control.Arrow (second) @@ -57,12 +60,14 @@ data AppConfig = AppConfig -- ^ initial set of users with their wallets on blockchain -- the wallet for lending app wil be created automatically. -- no need to include it here + , appConfig'currencySymbol :: CurrencySymbol + -- ^ lending app main currency symbol } -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: AppConfig -> App initApp AppConfig{..} = App - { app'pool = LendingPool (AM.fromList (fmap (second initReserve) appConfig'reserves)) AM.empty + { app'pool = LendingPool (AM.fromList (fmap (second initReserve) appConfig'reserves)) AM.empty appConfig'currencySymbol , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users } @@ -71,19 +76,23 @@ initApp AppConfig{..} = App -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. defaultAppConfig :: AppConfig -defaultAppConfig = AppConfig reserves users +defaultAppConfig = AppConfig reserves users curSym where + curSym = currencySymbol "lending-app" + reserves = fmap (, R.fromInteger 1) [coin1, coin2, coin3] - coin1 = Coin "Dollar" - coin2 = Coin "Euro" - coin3 = Coin "Lira" + coin1 = toCoin "Dollar" + coin2 = toCoin "Euro" + coin3 = toCoin "Lira" users = [user1, user2, user3] - user1 = (UserId 1, wal (coin1, 100)) - user2 = (UserId 2, wal (coin2, 100)) - user3 = (UserId 3, wal (coin3, 100)) + user1 = (UserId (PubKeyHash "1"), wal (coin1, 100)) + user2 = (UserId (PubKeyHash "2"), wal (coin2, 100)) + user3 = (UserId (PubKeyHash "3"), wal (coin3, 100)) wal cs = BchWallet $ uncurry M.singleton cs +toCoin :: ByteString -> Coin +toCoin str = AssetClass (currencySymbol str, tokenName str) diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs index 69f804aef..3e66a8f51 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -73,7 +73,7 @@ applyResp resp (BchState wallets) = fmap BchState $ case resp of upd amt x | res >= 0 = Right $ Just res - | otherwise = Left $ "Negative balance for " <> showt resp + | otherwise = Left $ "Negative balance" where res = fromMaybe 0 x + amt diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 7e9aa3f4a..1ef6bfe1f 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -1,6 +1,13 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- | State transitions for Aave-like application module Mlabs.Lending.Logic.React( - react + react ) where import qualified PlutusTx.Ratio as R @@ -25,6 +32,10 @@ react = \case PriceAct act -> priceAct act GovernAct act -> governAct act where + aToken coin = do + curSym <- gets lp'currency + pure $ toLendingToken curSym coin + -- | User acts userAct uid = \case DepositAct{..} -> depositAct uid act'amount act'asset @@ -42,9 +53,10 @@ react = \case -- TODO: ignores ratio of liquidity to borrowed totals depositAct uid amount asset = do modifyWalletAndReserve uid asset depositUser + aCoin <- aToken asset pure $ mconcat - [ [Mint (aToken asset) amount] - , moveFromTo Self uid (aToken asset) amount + [ [Mint aCoin amount] + , moveFromTo Self uid aCoin amount , moveFromTo uid Self asset amount ] where @@ -72,12 +84,11 @@ react = \case hasEnoughLiquidityToBorrow asset amount = do liquidity <- getsReserve asset (wallet'deposit . reserve'wallet) - guardError ("Not enough liquidity for asset " <> showt asset) - (liquidity >= amount) + guardError "Not enough liquidity for asset" (liquidity >= amount) collateralNonBorrow uid asset = do col <- getsWallet uid asset wallet'collateral - guardError (mconcat ["Collateral can not be used as borrow for user ", showt uid, " for asset ", showt asset]) + guardError "Collateral can not be used as borrow for user" (col == 0) hasEnoughCollateral uid asset amount = do @@ -85,7 +96,7 @@ react = \case isOk <- getHealthCheck bor asset =<< getUser uid guardError msg isOk where - msg = mconcat ["Not enough collateral to borrow ", showt amount, " ", showt asset, " for user ", showt uid] + msg = "Not enough collateral to borrow" --------------------------------------------------- -- repay (also called redeem in whitepaper) @@ -120,9 +131,10 @@ react = \case { wallet'deposit = wallet'deposit w - amount , wallet'collateral = wallet'collateral w + amount } + aCoin <- aToken asset pure $ mconcat - [ moveFromTo uid Self (aToken asset) amount - , [Burn (aToken asset) amount] + [ moveFromTo uid Self aCoin amount + , [Burn aCoin amount] ] setAsDeposit uid asset portion @@ -133,7 +145,8 @@ react = \case { wallet'deposit = wallet'deposit w + amount , wallet'collateral = wallet'collateral w - amount } - pure $ moveFromTo Self uid (aToken asset) amount + aCoin <- aToken asset + pure $ moveFromTo Self uid aCoin amount getAmountBy extract uid asset portion = do val <- getsWallet uid asset extract @@ -147,15 +160,15 @@ react = \case hasEnoughDepositToWithdraw uid amount asset -- update state on withdraw modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount } + aCoin <- aToken asset pure $ mconcat - [ moveFromTo uid Self (aToken asset) amount + [ moveFromTo uid Self aCoin amount , moveFromTo Self uid asset amount ] hasEnoughDepositToWithdraw uid amount asset = do dep <- getsWallet uid asset wallet'deposit - guardError (mconcat ["Not enough deposit to withdraw ", showt amount, " ", showt asset, " for user ", showt uid]) - (dep >= amount) + guardError "Not enough deposit to withdraw" (dep >= amount) --------------------------------------------------- -- flash loan @@ -191,12 +204,13 @@ react = \case -- Adds new reserve (new coin/asset) addReserve coin val = do - LendingPool reserves users <- get + LendingPool reserves users curSym <- get if M.member coin reserves then throwError "Reserve is already present" else do - put $ LendingPool (M.insert coin (initReserve val) reserves) users + put $ LendingPool (M.insert coin (initReserve val) reserves) users curSym return [] todo = return [] + diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index d155389b6..ed2773615 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | State transitions for Lending app module Mlabs.Lending.Logic.State( @@ -102,7 +104,7 @@ getReserve coin = do mReserve <- gets (M.lookup coin . lp'reserves) maybe err pure mReserve where - err = throwError $ "Uknown coin " <> showt coin + err = throwError "Uknown coin" {-# INLINABLE toAda #-} -- | Convert given currency to base currency @@ -166,10 +168,10 @@ modifyReserve coin f = modifyReserve' coin (Right . f) -- | Modify reserve for a given asset. It can throw errors. modifyReserve' :: Coin -> (Reserve -> Either Error Reserve) -> St () modifyReserve' asset f = do - LendingPool lp users <- get + LendingPool lp users curSym <- get case M.lookup asset lp of - Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users) (f reserve) - Nothing -> throwError $ mconcat ["Asset is not supported: ", showt asset] + Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym) (f reserve) + Nothing -> throwError $ "Asset is not supported" {-# INLINABLE modifyUser #-} -- | Modify user info by id. @@ -180,10 +182,10 @@ modifyUser uid f = modifyUser' uid (Right . f) -- | Modify user info by id. It can throw errors. modifyUser' :: UserId -> (User -> Either Error User) -> St () modifyUser' uid f = do - LendingPool lp users <- get + LendingPool lp users curSym <- get case f $ fromMaybe defaultUser $ M.lookup uid users of Left msg -> throwError msg - Right user -> put $ LendingPool lp (M.insert uid user users) + Right user -> put $ LendingPool lp (M.insert uid user users) curSym {-# INLINABLE modifyWalletAndReserve #-} -- | Modify user wallet and reserve wallet with the same function. diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 16d30ff79..7f9a48b3d 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -1,3 +1,11 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Types for lending app -- -- inspired by aave spec. See @@ -19,33 +27,33 @@ module Mlabs.Lending.Logic.Types( , GovernAct(..) , LpAddressesProvider(..) , LpAddressesProviderRegistry(..) - , Coin(..) - , aToken + , Coin + , toLendingToken , LpCollateralManager(..) , LpConfigurator(..) , PriceOracleProvider(..) , InterestRateStrategy(..) - , showt + , Showt(..) ) where + import qualified Prelude as P import qualified PlutusTx as PlutusTx import PlutusTx.Prelude +import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) import PlutusTx.AssocMap (Map) import qualified PlutusTx.AssocMap as M import GHC.Generics +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) -import Data.String - -{-# INLINABLE showt #-} --- | Helper to print @Text@ values -showt :: Show a => a -> String -showt = fromString . show +-- | Class that converts to inlinable builtin string +class Showt a where + showt :: a -> String -- | Address of the wallet that can hold values of assets data UserId - = UserId Integer -- user address - | Self -- addres of the lending platform + = UserId PubKeyHash -- user address + | Self -- addres of the lending platform deriving (Show, Generic, P.Eq, P.Ord) instance Eq UserId where @@ -58,6 +66,7 @@ instance Eq UserId where data LendingPool = LendingPool { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app + , lp'currency :: !CurrencySymbol } deriving (Show, Generic) @@ -174,17 +183,12 @@ data PriceAct deriving (Show, Generic) -- | Custom currency -newtype Coin = Coin ByteString - deriving newtype (Show, P.Eq, P.Ord) - -instance Eq Coin where - {-# INLINABLE (==) #-} - Coin a == Coin b = a == b +type Coin = AssetClass -{-# INLINABLE aToken #-} --- | Appends a prefix to all coins -aToken :: Coin -> Coin -aToken (Coin bs) = Coin $ "a" <> bs +{-# INLINABLE toLendingToken #-} +toLendingToken :: CurrencySymbol -> Coin -> Coin +toLendingToken lendingPoolCurrency (AssetClass (cs, tn)) = + AssetClass (lendingPoolCurrency, TokenName $ concatenate (unCurrencySymbol cs) (unTokenName tn)) ---------------------------------------------------- -- some types specific to aave @@ -209,7 +213,6 @@ data InterestRate = StableRate | VariableRate ------------------------------------------ PlutusTx.unstableMakeIsData ''InterestRate -PlutusTx.unstableMakeIsData ''Coin PlutusTx.unstableMakeIsData ''UserAct PlutusTx.unstableMakeIsData ''PriceAct PlutusTx.unstableMakeIsData ''GovernAct From 1e06b7c1f50d312ee4c1a92f1bf2e065967fc3e7 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 7 May 2021 13:13:36 +0300 Subject: [PATCH 20/81] Update tests, refactoring --- mlabs/mlabs-plutus-use-cases.cabal | 6 ++-- mlabs/src/Mlabs/Lending.hs | 4 +-- .../src/Mlabs/Lending/{ => Contract}/Coin.hs | 2 +- .../Mlabs/Lending/{ => Contract}/Lendex.hs | 2 +- .../src/Mlabs/Lending/{ => Contract}/Utils.hs | 2 +- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 4 +-- mlabs/test/Test/Lending.hs | 2 +- mlabs/test/Test/Lending/Logic.hs | 30 ++++++++++++------- 8 files changed, 31 insertions(+), 21 deletions(-) rename mlabs/src/Mlabs/Lending/{ => Contract}/Coin.hs (95%) rename mlabs/src/Mlabs/Lending/{ => Contract}/Lendex.hs (98%) rename mlabs/src/Mlabs/Lending/{ => Contract}/Utils.hs (91%) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index a437b5b69..f4cff5fc4 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -43,14 +43,14 @@ library hs-source-dirs: src/ exposed-modules: Mlabs.Lending - Mlabs.Lending.Coin - Mlabs.Lending.Lendex + Mlabs.Lending.Contract.Coin + Mlabs.Lending.Contract.Lendex + Mlabs.Lending.Contract.Utils Mlabs.Lending.Logic.App Mlabs.Lending.Logic.Emulator Mlabs.Lending.Logic.React Mlabs.Lending.Logic.State Mlabs.Lending.Logic.Types - Mlabs.Lending.Utils default-extensions: BangPatterns ExplicitForAll FlexibleContexts diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs index 3da50256d..cf73af469 100644 --- a/mlabs/src/Mlabs/Lending.hs +++ b/mlabs/src/Mlabs/Lending.hs @@ -40,8 +40,8 @@ import Text.Printf (printf) import qualified Plutus.Trace as Trace import Plutus.Contract.Trace (Wallet) import Plutus.Trace (EmulatorTrace) -import Mlabs.Lending.Coin -import Mlabs.Lending.Utils +import Mlabs.Lending.Contract.Coin +import Mlabs.Lending.Contract.Utils import qualified Data.Text as T diff --git a/mlabs/src/Mlabs/Lending/Coin.hs b/mlabs/src/Mlabs/Lending/Contract/Coin.hs similarity index 95% rename from mlabs/src/Mlabs/Lending/Coin.hs rename to mlabs/src/Mlabs/Lending/Contract/Coin.hs index 6ef15781d..41cbb4784 100644 --- a/mlabs/src/Mlabs/Lending/Coin.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Coin.hs @@ -1,7 +1,7 @@ {-# options_ghc -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-specialize #-} -module Mlabs.Lending.Coin where +module Mlabs.Lending.Contract.Coin where import PlutusTx.Prelude (Integer, Bool, Eq(..)) diff --git a/mlabs/src/Mlabs/Lending/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs similarity index 98% rename from mlabs/src/Mlabs/Lending/Lendex.hs rename to mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 1ea1d0550..efc93d0dd 100644 --- a/mlabs/src/Mlabs/Lending/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} -module Mlabs.Lending.Lendex( +module Mlabs.Lending.Contract.Lendex( userEndpoints , mkValidator , scriptInstance diff --git a/mlabs/src/Mlabs/Lending/Utils.hs b/mlabs/src/Mlabs/Lending/Contract/Utils.hs similarity index 91% rename from mlabs/src/Mlabs/Lending/Utils.hs rename to mlabs/src/Mlabs/Lending/Contract/Utils.hs index fed9b9d10..e2bca474d 100644 --- a/mlabs/src/Mlabs/Lending/Utils.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Utils.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-specialize #-} -module Mlabs.Lending.Utils where +module Mlabs.Lending.Contract.Utils where import PlutusTx.Prelude ((.), error) import qualified PlutusTx.Prelude as Plutus diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs index 3e66a8f51..8204ecefc 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs @@ -8,7 +8,7 @@ module Mlabs.Lending.Logic.Emulator( , moveFromTo ) where -import Prelude () +import qualified Prelude as P import PlutusTx.Prelude hiding (fromMaybe, maybe) import Data.Maybe @@ -22,7 +22,7 @@ newtype BchState = BchState (Map UserId BchWallet) -- " For simplicity wallet is a map of coins to balances. newtype BchWallet = BchWallet (Map Coin Integer) - deriving newtype (Show) + deriving newtype (Show, P.Eq) instance Eq BchWallet where (BchWallet a) == (BchWallet b) = M.toList a == M.toList b diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs index 2f8dedb7f..d55e061e9 100644 --- a/mlabs/test/Test/Lending.hs +++ b/mlabs/test/Test/Lending.hs @@ -17,7 +17,7 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified Mlabs.Lending as L -import qualified Mlabs.Lending.Coin as L +import qualified Mlabs.Lending.Contract.Coin as L import Test.Utils diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index bd844d64e..0b6d790a4 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -7,11 +7,15 @@ module Test.Lending.Logic( import Test.Tasty import Test.Tasty.HUnit +import Plutus.V1.Ledger.Value +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) + import Mlabs.Lending.Logic.App import Mlabs.Lending.Logic.Emulator import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M +import qualified PlutusTx.Ratio as R noErrors :: App -> Bool noErrors app = null $ app'log app @@ -88,7 +92,7 @@ borrowScript = mconcat , [ UserAct user1 $ SetUserReserveAsCollateralAct { act'asset = coin1 , act'useAsCollateral = True - , act'portion = 1 + , act'portion = R.fromInteger 1 } , UserAct user1 $ BorrowAct { act'asset = coin2 @@ -116,7 +120,7 @@ borrowNotEnoughCollateralScript = mconcat , [ UserAct user1 $ SetUserReserveAsCollateralAct { act'asset = coin1 , act'useAsCollateral = True - , act'portion = 1 + , act'portion = R.fromInteger 1 } , UserAct user1 $ BorrowAct { act'asset = coin2 @@ -152,25 +156,31 @@ repayScript = mconcat --------------------------------- -- constants +aToken :: Coin -> Coin +aToken = toLendingToken lendingPoolCurrency + +lendingPoolCurrency :: CurrencySymbol +lendingPoolCurrency = currencySymbol "lending-pool" + -- users user1, user2, user3 :: UserId -user1 = UserId 1 -user2 = UserId 2 -user3 = UserId 3 +user1 = UserId $ PubKeyHash "1" +user2 = UserId $ PubKeyHash "2" +user3 = UserId $ PubKeyHash "3" -- coins coin1, coin2, coin3 :: Coin -coin1 = Coin "Dollar" -coin2 = Coin "Euro" -coin3 = Coin "Lira" +coin1 = toCoin "Dollar" +coin2 = toCoin "Euro" +coin3 = toCoin "Lira" -- | Default application. -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. testAppConfig :: AppConfig -testAppConfig = AppConfig reserves users +testAppConfig = AppConfig reserves users lendingPoolCurrency where - reserves = fmap (, 1) [coin1, coin2, coin3] + reserves = fmap (, R.fromInteger 1) [coin1, coin2, coin3] users = [ (user1, wal (coin1, 100)) , (user2, wal (coin2, 100)) From cfb8abaa392ff01822d2951f6297090711447c6e Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 7 May 2021 17:41:22 +0300 Subject: [PATCH 21/81] Implements template for forging adn adds simple unit tests --- mlabs/Makefile | 5 +- mlabs/mlabs-plutus-use-cases.cabal | 2 + mlabs/src/Mlabs/Lending/Contract/Forge.hs | 25 +++++ mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 71 ++++++++++++++- mlabs/src/Mlabs/Lending/Logic/Types.hs | 27 ++++-- mlabs/test/Main.hs | 4 +- mlabs/test/Test/Lending.hs | 6 +- mlabs/test/Test/Lending/Contract.hs | 101 +++++++++++++++++++++ 8 files changed, 226 insertions(+), 15 deletions(-) create mode 100644 mlabs/src/Mlabs/Lending/Contract/Forge.hs create mode 100644 mlabs/test/Test/Lending/Contract.hs diff --git a/mlabs/Makefile b/mlabs/Makefile index 9ae6f7c82..6d0f3a151 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -9,11 +9,14 @@ repl: stack ghci test: - stack test all + stack test all watch: stack build --file-watch --ghc-options="-Wall" +test-watch: + stack test --file-watch + # Target to use as dependency to fail if not inside nix-shell requires_nix_shell: @ [ -v IN_NIX_SHELL ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index f4cff5fc4..b98858db8 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -44,6 +44,7 @@ library exposed-modules: Mlabs.Lending Mlabs.Lending.Contract.Coin + Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex Mlabs.Lending.Contract.Utils Mlabs.Lending.Logic.App @@ -123,6 +124,7 @@ Test-suite mlabs-plutus-use-cases-tests hs-source-dirs: test Main-is: Main.hs Other-modules: Test.Lending + Test.Lending.Contract Test.Lending.Logic , Test.Utils default-extensions: diff --git a/mlabs/src/Mlabs/Lending/Contract/Forge.hs b/mlabs/src/Mlabs/Lending/Contract/Forge.hs new file mode 100644 index 000000000..0d9970521 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract/Forge.hs @@ -0,0 +1,25 @@ +module Mlabs.Lending.Contract.Forge( + currencySymbol +) where + +import PlutusTx.Prelude + +import Ledger (CurrencySymbol) + +import Ledger.Typed.Scripts (MonetaryPolicy) +import qualified Plutus.V1.Ledger.Scripts as Scripts +import qualified Ledger.Typed.Scripts as Scripts +import qualified PlutusTx as PlutusTx +import Plutus.V1.Ledger.Contexts + +{-# INLINABLE validate #-} +validate :: ScriptContext -> Bool +validate _ = True + +currencyPolicy :: MonetaryPolicy +currencyPolicy = Scripts.mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy validate ||]) + +currencySymbol :: CurrencySymbol +currencySymbol = scriptCurrencySymbol currencyPolicy + diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index efc93d0dd..58f74f70c 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -1,16 +1,31 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} module Mlabs.Lending.Contract.Lendex( - userEndpoints - , mkValidator + mkValidator , scriptInstance + -- * Endpoints + , UserLendexSchema, UserApp + , userEndpoints + , PriceOracleLendexSchema, PriceOracleApp + , priceOracleEndpoints + , GovernLendexSchema, GovernApp + , governEndpoints + , StartParams(..) + -- * Test endpoints + , callUserAct + , callPriceOracleAct + , callGovernAct + , callStartLendex ) where import Control.Monad (forever) import Control.Monad.State.Strict (runStateT) +import Data.Aeson (FromJSON, ToJSON) import Data.Functor (void) +import GHC.Generics + import Plutus.V1.Ledger.Contexts (pubKeyHash) import Plutus.Contract import qualified Plutus.Contract.StateMachine as SM @@ -20,6 +35,10 @@ import PlutusTx.Prelude hiding (Applicative (..), check) import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types +import qualified Mlabs.Lending.Contract.Forge as Forge + +import Plutus.Trace.Emulator (EmulatorTrace, callEndpoint, activateContractWallet) +import qualified Wallet.Emulator as Emulator type Lendex = SM.StateMachine LendingPool Act @@ -49,9 +68,12 @@ transition :: -> Act -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of - Left _ -> Nothing + Left _err -> Nothing Right (_, newData) -> Just (mempty, SM.State { stateData=newData, stateValue=oldValue }) +----------------------------------------------------------------------- +-- endpoints and schemas + type LendexError = SM.SMContractError type UserLendexSchema = @@ -90,6 +112,13 @@ priceOracleEndpoints = forever priceOracleAction' type GovernLendexSchema = BlockchainActions .\/ Endpoint "govern-action" GovernAct + .\/ Endpoint "start-lendex" StartParams + +data StartParams = StartParams + { sp'coins :: [(Coin, Rational)] -- ^ supported coins with ratios to ADA + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) type GovernApp a = Contract () GovernLendexSchema LendexError a @@ -97,9 +126,43 @@ governAction :: GovernAct -> GovernApp () governAction act = do void $ SM.runStep client (GovernAct act) +startLendex :: StartParams -> GovernApp () +startLendex StartParams{..} = do + void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins) initValue + where + initValue = mempty + -- | Endpoints for admin user governEndpoints :: GovernApp () -governEndpoints = forever governAction' +governEndpoints = startLendex' >> forever governAction' where governAction' = endpoint @"govern-action" >>= governAction + startLendex' = endpoint @"start-lendex" >>= startLendex + +--------------------------------------------------------- +-- call endpoints (for debug and testing) + +-- | Calls user act +callUserAct :: Emulator.Wallet -> UserAct -> EmulatorTrace () +callUserAct wal act = do + hdl <- activateContractWallet wal userEndpoints + void $ callEndpoint @"user-action" hdl act + +-- | Calls price oracle act +callPriceOracleAct :: Emulator.Wallet -> PriceAct -> EmulatorTrace () +callPriceOracleAct wal act = do + hdl <- activateContractWallet wal priceOracleEndpoints + void $ callEndpoint @"price-oracle-action" hdl act + +-- | Calls govern act +callGovernAct :: Emulator.Wallet -> GovernAct -> EmulatorTrace () +callGovernAct wal act = do + hdl <- activateContractWallet wal governEndpoints + void $ callEndpoint @"govern-action" hdl act + +-- | Calls initialisation of state for Lending pool +callStartLendex :: Emulator.Wallet -> StartParams -> EmulatorTrace () +callStartLendex wal sp = do + hdl <- activateContractWallet wal governEndpoints + void $ callEndpoint @"start-lendex" hdl sp diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 7f9a48b3d..eeda88cdd 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -21,6 +21,7 @@ module Mlabs.Lending.Logic.Types( , Reserve(..) , InterestRate(..) , initReserve + , initLendingPool , Act(..) , UserAct(..) , PriceAct(..) @@ -37,6 +38,8 @@ module Mlabs.Lending.Logic.Types( ) where +import Data.Aeson (FromJSON, ToJSON) + import qualified Prelude as P import qualified PlutusTx as PlutusTx import PlutusTx.Prelude @@ -54,7 +57,8 @@ class Showt a where data UserId = UserId PubKeyHash -- user address | Self -- addres of the lending platform - deriving (Show, Generic, P.Eq, P.Ord) + deriving stock (Show, Generic, P.Eq, P.Ord) + deriving anyclass (FromJSON, ToJSON) instance Eq UserId where {-# INLINABLE (==) #-} @@ -79,6 +83,12 @@ data Reserve = Reserve } deriving (Show, Generic) +{-# INLINABLE initLendingPool #-} +initLendingPool :: CurrencySymbol -> [(Coin, Rational)] -> LendingPool +initLendingPool curSym coins = LendingPool reserves M.empty curSym + where + reserves = M.fromList $ fmap (\(coin, rat) -> (coin, initReserve rat)) coins + {-# INLINABLE initReserve #-} -- | Initialise empty reserve with given ratio of its coin to ada initReserve :: Rational -> Reserve @@ -122,7 +132,8 @@ data Act = UserAct UserId UserAct -- ^ user's actions | PriceAct PriceAct -- ^ price oracle's actions | GovernAct GovernAct -- ^ app admin's actions - deriving (Show, Generic) + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Lending pool action data UserAct @@ -169,18 +180,21 @@ data UserAct , act'receiveAToken :: Bool } -- ^ call to liquidate borrows that are unsafe due to health check - deriving (Show, Generic) + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Acts that can be done by admin users. data GovernAct = AddReserve Coin Rational -- ^ Adds new reserve - deriving (Show, Generic) + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Updates for the prices of the currencies on the markets data PriceAct = SetAssetPrice Coin Rational -- ^ Set asset price | SetOracleAddr Coin UserId -- ^ Provide address of the oracle - deriving (Show, Generic) + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Custom currency type Coin = AssetClass @@ -208,7 +222,8 @@ data PriceOracleProvider = PriceOracleProvider data InterestRateStrategy = InterestRateStrategy data InterestRate = StableRate | VariableRate - deriving (Show) + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) ------------------------------------------ diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index a9297f854..50d36f404 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -2,12 +2,14 @@ module Main where import Test.Tasty +import qualified Test.Lending.Contract as Contract import qualified Test.Lending.Logic as Logic import qualified Test.Lending as Lending main :: IO () main = defaultMain $ testGroup "Lending" [ Logic.test - , Lending.tests + , Contract.test + , Lending.test ] diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs index d55e061e9..a10f9604d 100644 --- a/mlabs/test/Test/Lending.hs +++ b/mlabs/test/Test/Lending.hs @@ -1,6 +1,6 @@ -- | Test suite for lending exchange module Test.Lending( - tests + test ) where import Prelude @@ -22,8 +22,8 @@ import qualified Mlabs.Lending.Contract.Coin as L import Test.Utils -- | Test suite for lending exchange -tests :: TestTree -tests = testGroup "Lending" +test :: TestTree +test = testGroup "Lending" [ testCreate ] diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs new file mode 100644 index 000000000..59d392073 --- /dev/null +++ b/mlabs/test/Test/Lending/Contract.hs @@ -0,0 +1,101 @@ +-- | Tests for lending application contracts. +module Test.Lending.Contract( + test +) where + +import Prelude + +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Plutus.V1.Ledger.Ada as Ada +import qualified Plutus.V1.Ledger.Value as Value +import qualified Data.Map as M + +import Plutus.Contract.Test hiding (tx) +import qualified Plutus.Trace.Emulator as Trace +import qualified PlutusTx.Ratio as R + +import Mlabs.Lending.Logic.Types (Coin, UserAct(..), InterestRate(..)) +import qualified Mlabs.Lending.Logic.App as L +import qualified Mlabs.Lending.Contract.Lendex as L + +import Test.Utils + +test :: TestTree +test = testGroup "Contract" + [ testCase "Deposit" testDeposit + , testCase "Borrow" testBorrow + ] + where + testDeposit = testNoErrors initConfig depositScript + testBorrow = testNoErrors initConfig borrowScript + +-- | 3 users deposit 50 coins to lending app. Each of them uses different coin. +depositScript :: Trace.EmulatorTrace () +depositScript = do + L.callStartLendex w1 $ L.StartParams + { sp'coins = fmap (, R.fromInteger 1) [adaCoin, coin1, coin2, coin3] } + next + userAct1 $ DepositAct 50 coin1 + userAct2 $ DepositAct 50 coin2 + userAct3 $ DepositAct 50 coin3 + next + +-- | 3 users deposit 50 coins to lending app +-- and first user borrows in coin2 that he does not own prior to script run. +borrowScript :: Trace.EmulatorTrace () +borrowScript = do + depositScript + userAct1 SetUserReserveAsCollateralAct + { act'asset = coin1 + , act'useAsCollateral = True + , act'portion = R.fromInteger 1 + } + next + userAct1 $ BorrowAct + { act'asset = coin2 + , act'amount = 30 + , act'rate = StableRate + } + next + +------------------------------------------------------------------------------------ +-- init blockchain state + +-- | Wallets that are used for testing. +w1, w2, w3 :: Wallet +w1 = Wallet 1 +w2 = Wallet 2 +w3 = Wallet 3 + +userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () +userAct1 = L.callUserAct w1 +userAct2 = L.callUserAct w2 +userAct3 = L.callUserAct w3 + +-- coins +adaCoin, coin1, coin2, coin3 :: Coin +coin1 = L.toCoin "Dollar" +coin2 = L.toCoin "Euro" +coin3 = L.toCoin "Lira" + +adaCoin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) + +-- | Initial config +initConfig :: Trace.EmulatorConfig +initConfig = cfg + where + cfg = Trace.EmulatorConfig $ Left $ M.fromList + [ (w1, val 1000 <> v1 100) + , (w2, val 1000 <> v2 100) + , (w3, val 1000 <> v3 100) + ] + + val x = Value.singleton Ada.adaSymbol Ada.adaToken x + + coinVal coin = uncurry Value.singleton (Value.unAssetClass coin) + v1 = coinVal coin1 + v2 = coinVal coin2 + v3 = coinVal coin3 + From 7479dadfedcb629f48b9659abf58dbb53cab42ce Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 10 May 2021 19:28:47 +0300 Subject: [PATCH 22/81] Struggle with single thread behavior of StateMachine. Need more refined tests --- mlabs/mlabs-plutus-use-cases.cabal | 8 +-- mlabs/src/Mlabs/Lending/Contract/Forge.hs | 3 +- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 63 ++++++++++++++++++++-- mlabs/test/Main.hs | 3 +- mlabs/test/Test/Lending/Contract.hs | 8 ++- 5 files changed, 72 insertions(+), 13 deletions(-) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index b98858db8..494c3c0f9 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -42,7 +42,7 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: - Mlabs.Lending +-- Mlabs.Lending Mlabs.Lending.Contract.Coin Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex @@ -105,6 +105,7 @@ Test-suite mlabs-plutus-use-cases-tests Ghc-options: -Wall -threaded -rtsopts Default-Language: Haskell2010 Build-Depends: base >=4.9 && <5 + , data-default , mlabs-plutus-use-cases , containers , playground-common @@ -123,10 +124,11 @@ Test-suite mlabs-plutus-use-cases-tests , text hs-source-dirs: test Main-is: Main.hs - Other-modules: Test.Lending + Other-modules: + -- Test.Lending Test.Lending.Contract Test.Lending.Logic - , Test.Utils + Test.Utils default-extensions: RecordWildCards OverloadedStrings diff --git a/mlabs/src/Mlabs/Lending/Contract/Forge.hs b/mlabs/src/Mlabs/Lending/Contract/Forge.hs index 0d9970521..35e4f43e9 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Forge.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Forge.hs @@ -1,5 +1,6 @@ module Mlabs.Lending.Contract.Forge( - currencySymbol + currencySymbol + , currencyPolicy ) where import PlutusTx.Prelude diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 58f74f70c..881db393c 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -18,6 +18,8 @@ module Mlabs.Lending.Contract.Lendex( , callStartLendex ) where +import qualified Prelude as P + import Control.Monad (forever) import Control.Monad.State.Strict (runStateT) @@ -29,10 +31,16 @@ import GHC.Generics import Plutus.V1.Ledger.Contexts (pubKeyHash) import Plutus.Contract import qualified Plutus.Contract.StateMachine as SM +import Ledger hiding (singleton) import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value (AssetClass (..), assetClassValue, assetClassValueOf, assetClass) +import Ledger.Constraints import qualified PlutusTx as PlutusTx -import PlutusTx.Prelude hiding (Applicative (..), check) +import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) +import qualified PlutusTx.Prelude as PlutusTx + +import Mlabs.Lending.Logic.Emulator import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types import qualified Mlabs.Lending.Contract.Forge as Forge @@ -68,8 +76,10 @@ transition :: -> Act -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of - Left _err -> Nothing - Right (_, newData) -> Just (mempty, SM.State { stateData=newData, stateValue=oldValue }) + Left _err -> Nothing + Right (resps, newData) -> Just ( foldMap toConstraints resps + , SM.State { stateData=newData + , stateValue= updateLendexValue resps oldValue }) ----------------------------------------------------------------------- -- endpoints and schemas @@ -85,7 +95,24 @@ type UserApp a = Contract () UserLendexSchema LendexError a userAction :: UserAct -> UserApp () userAction act = do pkh <- fmap pubKeyHash ownPubKey - void $ SM.runStep client (UserAct (UserId pkh) act) + let lookups = monetaryPolicy Forge.currencyPolicy P.<> + ownPubKeyHash pkh + t <- SM.mkStep client (UserAct (UserId pkh) act) + logInfo @String $ "Executes action " P.<> show act + case t of + Left err -> logError ("Action failed" :: String) + Right SM.StateMachineTransition{smtConstraints=constraints, smtLookups=lookups'} -> do + tx <- submitTxConstraintsWith (lookups P.<> lookups') constraints + awaitTxConfirmed (txId tx) + +{- + case t of + Left{} -> return () -- Ignore invalid transitions + Right StateMachineTransition{smtConstraints=constraints, smtLookups=lookups'} -> do + tx <- submitTxConstraintsWith (lookups <> lookups') constraints + awaitTxConfirmed (txId tx) +-} + -- | Endpoints for user userEndpoints :: UserApp () @@ -130,7 +157,7 @@ startLendex :: StartParams -> GovernApp () startLendex StartParams{..} = do void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins) initValue where - initValue = mempty + initValue = PlutusTx.mempty -- | Endpoints for admin user governEndpoints :: GovernApp () @@ -139,6 +166,32 @@ governEndpoints = startLendex' >> forever governAction' governAction' = endpoint @"govern-action" >>= governAction startLendex' = endpoint @"start-lendex" >>= startLendex +--------------------------------------------------------- + +{-# INLINABLE toConstraints #-} +toConstraints :: Resp -> TxConstraints SM.Void SM.Void +toConstraints = \case + Move addr coin amount | amount > 0 -> case addr of + -- pays to lendex app + Self -> PlutusTx.mempty -- we already check this constraint with StateMachine + -- pays to the user + UserId pkh -> mustPayToPubKey pkh (assetClassValue coin amount) + Mint coin amount -> mustForgeValue (assetClassValue coin amount) + Burn coin amount -> mustForgeValue (assetClassValue coin $ negate amount) + _ -> PlutusTx.mempty + +{-# INLINABLE updateLendexValue #-} +updateLendexValue :: [Resp] -> Value -> Value +updateLendexValue rs val = foldMap toLendexValue rs PlutusTx.<> val + +{-# INLINABLE toLendexValue #-} +toLendexValue :: Resp -> Value +toLendexValue = \case + Move Self coin amount -> assetClassValue coin amount + Mint coin amount -> assetClassValue coin amount + Burn coin amount -> assetClassValue coin (negate amount) + _ -> PlutusTx.mempty + --------------------------------------------------------- -- call endpoints (for debug and testing) diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index 50d36f404..e7c41c366 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -4,12 +4,11 @@ import Test.Tasty import qualified Test.Lending.Contract as Contract import qualified Test.Lending.Logic as Logic -import qualified Test.Lending as Lending +-- import qualified Test.Lending as Lending main :: IO () main = defaultMain $ testGroup "Lending" [ Logic.test , Contract.test - , Lending.test ] diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 59d392073..eb4a3288e 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -5,6 +5,8 @@ module Test.Lending.Contract( import Prelude +import Data.Default + import Test.Tasty import Test.Tasty.HUnit @@ -29,14 +31,16 @@ test = testGroup "Contract" ] where testDeposit = testNoErrors initConfig depositScript - testBorrow = testNoErrors initConfig borrowScript + testBorrow = do + Trace.runEmulatorTraceIO' def initConfig borrowScript + testNoErrors initConfig borrowScript -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. depositScript :: Trace.EmulatorTrace () depositScript = do L.callStartLendex w1 $ L.StartParams { sp'coins = fmap (, R.fromInteger 1) [adaCoin, coin1, coin2, coin3] } - next + wait 5 userAct1 $ DepositAct 50 coin1 userAct2 $ DepositAct 50 coin2 userAct3 $ DepositAct 50 coin3 From 2b9d3cef3b089758ddeb30a37c84301e0a058893 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 12 May 2021 12:53:30 +0300 Subject: [PATCH 23/81] implements monetary policy validation --- mlabs/mlabs-plutus-use-cases.cabal | 1 + mlabs/src/Mlabs/Lending/Contract/Forge.hs | 118 ++++++++++++++++++++- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 43 +++++--- mlabs/src/Mlabs/Lending/Contract/Utils.hs | 10 ++ mlabs/src/Mlabs/Lending/Logic/App.hs | 24 ++--- mlabs/src/Mlabs/Lending/Logic/React.hs | 20 ++-- mlabs/src/Mlabs/Lending/Logic/State.hs | 17 ++- mlabs/src/Mlabs/Lending/Logic/Types.hs | 47 ++++++-- mlabs/test/Test/Lending/Contract.hs | 17 ++- mlabs/test/Test/Lending/Logic.hs | 24 +++-- 10 files changed, 250 insertions(+), 71 deletions(-) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 494c3c0f9..7a67498bb 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -24,6 +24,7 @@ library , aeson , bytestring , containers + , extra , mtl , playground-common , plutus-core diff --git a/mlabs/src/Mlabs/Lending/Contract/Forge.hs b/mlabs/src/Mlabs/Lending/Contract/Forge.hs index 35e4f43e9..24dd72980 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Forge.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Forge.hs @@ -3,19 +3,133 @@ module Mlabs.Lending.Contract.Forge( , currencyPolicy ) where -import PlutusTx.Prelude +import Control.Monad.State.Strict (evalStateT) +import PlutusTx.Prelude import Ledger (CurrencySymbol) import Ledger.Typed.Scripts (MonetaryPolicy) +import qualified Plutus.V1.Ledger.Value as Value import qualified Plutus.V1.Ledger.Scripts as Scripts import qualified Ledger.Typed.Scripts as Scripts import qualified PlutusTx as PlutusTx import Plutus.V1.Ledger.Contexts +import Ledger.Constraints + +import Mlabs.Lending.Logic.Types +import Mlabs.Lending.Logic.State + +data Input = Input + { input'state :: !LendingPool + , input'value :: !Value.Value + } {-# INLINABLE validate #-} +-- | Validation script for monetary policy. +-- +-- We allow user to forge coins just in two cases: +-- +-- * mint new aTokens in exchange for real tokens on deposit to lending app +-- * burn aTokens on withdraw from lending app +-- +-- For mint case we check that: +-- +-- * user deposit has grown properly on user's internal wallet for lending pool state +-- * user has paid enough real tokens to get aTokens +-- * script has paid enough aTokens to user in return +-- +-- For burn case we check that: +-- +-- * user deposit has diminished properly on user's internal wallet for leding pool state +-- * user has paid enough aTokens to script +-- * script has paid enough real tokens to the use rin return validate :: ScriptContext -> Bool -validate _ = True +validate ctx = case (getInState, getOutState) of + (Just st1, Just st2) -> all (isValidForge st1 st2) $ Value.flattenValue $ txInfoForge info + (Just _ , Nothing) -> traceIfFalse "Failed to find LendingPool state in outputs" False + (Nothing, Just _) -> traceIfFalse "Failed to find LendingPool state in inputs" False + _ -> traceIfFalse "Failed to find TxOut with LendingPool state" False + where + -- find datum of lending app state in the inputs + getInState = getStateForOuts $ fmap txInInfoResolved $ txInfoInputs info + + -- find datum of lending app state in the outputs + getOutState = getStateForOuts $ txInfoOutputs info + + getStateForOuts outs = uniqueElement $ mapMaybe stateForTxOut outs + + stateForTxOut :: TxOut -> Maybe Input + stateForTxOut out = do + dHash <- txOutDatumHash out + dat <- Scripts.getDatum <$> findDatum dHash info + st <- PlutusTx.fromData dat + pure $ Input st (txOutValue out) + + isValidForge :: Input -> Input -> (Value.CurrencySymbol, Value.TokenName, Integer) -> Bool + isValidForge st1 st2 (cur, token, amount) = case getTokenCoin st1 st2 cur token of + Just coin | amount >= 0 -> isValidMint st1 st2 coin aCoin amount + Just coin -> isValidBurn st1 st2 coin aCoin (negate amount) + Nothing -> traceIfFalse "Minted token is not supported" False + where + aCoin = Value.AssetClass (cur, token) + + getTokenCoin st1 st2 cur token + | isValidCurrency st1 st2 cur = fromAToken (input'state st1) token + | otherwise = Nothing + + -- check if states are based on the same monetary policy script + isValidCurrency st1 st2 cur = + cur == lp'currency (input'state st1) && cur == lp'currency (input'state st2) + + -- checks that user deposit becomes larger on given amount of minted tokens + -- and user pays given amount to the lending app. We go through the list of all signatures + -- to see if anyone acts as a user (satisfy constraints). + isValidMint (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = any checkUserMint users + where + checkUserMint uid = + checkUserDepositDiff uid + && checkUserPays + && checkScriptPays uid + + -- Check that user balance has growed on user inner wallet deposit + checkUserDepositDiff = checkUserDepositDiffBy (\dep1 dep2 -> dep2 - dep1 == amount) st1 st2 coin + + -- Check that user payed value to script. + -- We check that state value became bigger after state transition. + checkUserPays = stVal2 == (stVal1 <> Value.assetClassValue coin amount) + + -- Check that user recieved aCoins + checkScriptPays uid = checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue aCoin amount :: TxConstraints () ()) ctx + + isValidBurn (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = any checkUserBurn users + where + checkUserBurn uid = + checkUserDepositDiff uid + && checkUserPays + && checkScriptPays uid + + -- Check that user balance has diminished on user inner wallet deposit + checkUserDepositDiff = checkUserDepositDiffBy (\dep1 dep2 -> dep1 - dep2 == amount) st1 st2 coin + + -- Check that user payed value to script. + -- We check that state value became bigger after state transition + checkUserPays = stVal2 == (stVal1 <> Value.assetClassValue aCoin amount) + + -- Check that user recieved coins + checkScriptPays uid = checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue coin amount :: TxConstraints () ()) ctx + + -- check change of the user deposit for state prior to transition (st1) and after transition (st2) + checkUserDepositDiffBy cond st1 st2 coin uid = either (const False) id $ do + dep1 <- getDeposit uid coin st1 + dep2 <- getDeposit uid coin st2 + pure $ cond dep1 dep2 + + getDeposit uid coin st = evalStateT (getsWallet (UserId uid) coin wallet'deposit) st + + users = txInfoSignatories info + info = scriptContextTxInfo ctx + +------------------------------------------------------------------------------- currencyPolicy :: MonetaryPolicy currencyPolicy = Scripts.mkMonetaryPolicyScript $ diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 881db393c..fd16d7aa9 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -22,18 +22,18 @@ import qualified Prelude as P import Control.Monad (forever) import Control.Monad.State.Strict (runStateT) +import Data.List.Extra (firstJust) import Data.Aeson (FromJSON, ToJSON) import Data.Functor (void) import GHC.Generics -import Plutus.V1.Ledger.Contexts (pubKeyHash) import Plutus.Contract import qualified Plutus.Contract.StateMachine as SM import Ledger hiding (singleton) import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value (AssetClass (..), assetClassValue, assetClassValueOf, assetClass) +import Ledger.Value (assetClassValue) import Ledger.Constraints import qualified PlutusTx as PlutusTx import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) @@ -44,10 +44,16 @@ import Mlabs.Lending.Logic.Emulator import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types import qualified Mlabs.Lending.Contract.Forge as Forge +import Mlabs.Lending.Contract.Utils import Plutus.Trace.Emulator (EmulatorTrace, callEndpoint, activateContractWallet) import qualified Wallet.Emulator as Emulator +import qualified Data.Map as M + +import Data.Text.Prettyprint.Doc.Extras + + type Lendex = SM.StateMachine LendingPool Act {-# INLINABLE machine #-} @@ -63,6 +69,12 @@ mkValidator = SM.mkValidator machine client :: SM.StateMachineClient LendingPool Act client = SM.mkStateMachineClient $ SM.StateMachineInstance machine scriptInstance +lendexValidatorHash :: ValidatorHash +lendexValidatorHash = Scripts.scriptHash scriptInstance + +lendexAddress :: Address +lendexAddress = scriptHashAddress lendexValidatorHash + scriptInstance :: Scripts.ScriptInstance Lendex scriptInstance = Scripts.validator @Lendex $$(PlutusTx.compile [|| mkValidator ||]) @@ -92,28 +104,29 @@ type UserLendexSchema = type UserApp a = Contract () UserLendexSchema LendexError a +findInputStateDatum :: UserApp Datum +findInputStateDatum = do + utxos <- utxoAt lendexAddress + maybe err P.pure $ firstJust (readDatum . snd) $ M.toList utxos + where + err = throwError $ SM.SMCContractError "Can not find Lending app instance" + userAction :: UserAct -> UserApp () userAction act = do pkh <- fmap pubKeyHash ownPubKey + inputDatum <- findInputStateDatum let lookups = monetaryPolicy Forge.currencyPolicy P.<> ownPubKeyHash pkh + constraints = mustIncludeDatum inputDatum t <- SM.mkStep client (UserAct (UserId pkh) act) logInfo @String $ "Executes action " P.<> show act case t of - Left err -> logError ("Action failed" :: String) - Right SM.StateMachineTransition{smtConstraints=constraints, smtLookups=lookups'} -> do - tx <- submitTxConstraintsWith (lookups P.<> lookups') constraints + Left _err -> logError ("Action failed" :: String) + Right SM.StateMachineTransition{smtConstraints=constraints', smtLookups=lookups'} -> do + tx <- submitTxConstraintsWith (lookups P.<> lookups') (constraints P.<> constraints') + mapM_ (logInfo @String) (lines $ show $ pretty tx) awaitTxConfirmed (txId tx) -{- - case t of - Left{} -> return () -- Ignore invalid transitions - Right StateMachineTransition{smtConstraints=constraints, smtLookups=lookups'} -> do - tx <- submitTxConstraintsWith (lookups <> lookups') constraints - awaitTxConfirmed (txId tx) --} - - -- | Endpoints for user userEndpoints :: UserApp () userEndpoints = forever userAction' @@ -142,7 +155,7 @@ type GovernLendexSchema = .\/ Endpoint "start-lendex" StartParams data StartParams = StartParams - { sp'coins :: [(Coin, Rational)] -- ^ supported coins with ratios to ADA + { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA } deriving stock (Show, Generic) deriving anyclass (FromJSON, ToJSON) diff --git a/mlabs/src/Mlabs/Lending/Contract/Utils.hs b/mlabs/src/Mlabs/Lending/Contract/Utils.hs index e2bca474d..9289be92e 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Utils.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Utils.hs @@ -2,10 +2,14 @@ {-# OPTIONS_GHC -fno-specialize #-} module Mlabs.Lending.Contract.Utils where +import Prelude (Maybe(..), ($)) + import PlutusTx.Prelude ((.), error) import qualified PlutusTx.Prelude as Plutus import Ledger hiding (singleton) +import PlutusTx + {-# INLINABLE valueWithin #-} valueWithin :: TxInInfo -> Value valueWithin = txOutValue . txInInfoResolved @@ -14,4 +18,10 @@ valueWithin = txOutValue . txInInfoResolved findOwnInput' :: ScriptContext -> TxInInfo findOwnInput' ctx = Plutus.fromMaybe (error ()) (findOwnInput ctx) +-- | For off-chain code +readDatum :: IsData a => TxOutTx -> Maybe a +readDatum txOut = do + h <- txOutDatumHash $ txOutTxOut txOut + Datum e <- lookupDatum (txOutTxTx txOut) h + PlutusTx.fromData e diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 2d64756cd..21e43f92e 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -13,7 +13,6 @@ import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) import Plutus.V1.Ledger.Value import Control.Monad.State.Strict hiding (Functor(..)) -import Control.Arrow (second) import Data.List (foldl') @@ -54,7 +53,7 @@ runApp cfg acts = foldl' go (initApp cfg) acts -- Configuration paprameters for app. data AppConfig = AppConfig - { appConfig'reserves :: [(Coin, Rational)] + { appConfig'reserves :: [CoinCfg] -- ^ coins with ratios to base currencies for each reserve , appConfig'users :: [(UserId, BchWallet)] -- ^ initial set of users with their wallets on blockchain @@ -67,10 +66,12 @@ data AppConfig = AppConfig -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: AppConfig -> App initApp AppConfig{..} = App - { app'pool = LendingPool (AM.fromList (fmap (second initReserve) appConfig'reserves)) AM.empty appConfig'currencySymbol + { app'pool = LendingPool (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) AM.empty appConfig'currencySymbol coinMap , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users } + where + coinMap = AM.fromList $ fmap (\CoinCfg{..} -> (coinCfg'aToken, coinCfg'coin)) $ appConfig'reserves -- | Default application. -- It allocates three users nad three reserves for Dollars, Euros and Liras. @@ -79,20 +80,15 @@ defaultAppConfig :: AppConfig defaultAppConfig = AppConfig reserves users curSym where curSym = currencySymbol "lending-app" + userNames = ["1", "2", "3"] + coinNames = ["Dollar", "Euro", "Lira"] - reserves = fmap (, R.fromInteger 1) [coin1, coin2, coin3] - - coin1 = toCoin "Dollar" - coin2 = toCoin "Euro" - coin3 = toCoin "Lira" - - users = [user1, user2, user3] - - user1 = (UserId (PubKeyHash "1"), wal (coin1, 100)) - user2 = (UserId (PubKeyHash "2"), wal (coin2, 100)) - user3 = (UserId (PubKeyHash "3"), wal (coin3, 100)) + reserves = fmap (\name -> CoinCfg (toCoin name) (R.fromInteger 1) (toAToken name)) coinNames + users = zipWith (\coinName userName -> (UserId (PubKeyHash userName), wal (toCoin coinName, 100))) coinNames userNames wal cs = BchWallet $ uncurry M.singleton cs + toAToken name = tokenName $ "a" <> name + toCoin :: ByteString -> Coin toCoin str = AssetClass (currencySymbol str, tokenName str) diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 1ef6bfe1f..ed5e47c9d 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -32,10 +32,6 @@ react = \case PriceAct act -> priceAct act GovernAct act -> governAct act where - aToken coin = do - curSym <- gets lp'currency - pure $ toLendingToken curSym coin - -- | User acts userAct uid = \case DepositAct{..} -> depositAct uid act'amount act'asset @@ -133,9 +129,7 @@ react = \case } aCoin <- aToken asset pure $ mconcat - [ moveFromTo uid Self aCoin amount - , [Burn aCoin amount] - ] + [ moveFromTo uid Self aCoin amount ] setAsDeposit uid asset portion | portion <= R.fromInteger 0 = pure [] @@ -198,17 +192,19 @@ react = \case -- Govern acts governAct = \case - AddReserve coin val -> addReserve coin val + AddReserve cfg -> addReserve cfg --------------------------------------------------- -- Adds new reserve (new coin/asset) - addReserve coin val = do - LendingPool reserves users curSym <- get - if M.member coin reserves + addReserve cfg@CoinCfg{..} = do + LendingPool reserves users curSym coinMap <- get + if M.member coinCfg'coin reserves then throwError "Reserve is already present" else do - put $ LendingPool (M.insert coin (initReserve val) reserves) users curSym + let newReserves = M.insert coinCfg'coin (initReserve cfg) reserves + newCoinMap = M.insert coinCfg'aToken coinCfg'coin coinMap + put $ LendingPool newReserves users curSym newCoinMap return [] todo = return [] diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index ed2773615..4aadedf9e 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -6,6 +6,7 @@ module Mlabs.Lending.Logic.State( St , showt , Error + , aToken , initReserve , guardError , getWallet, getsWallet @@ -62,6 +63,14 @@ instance Applicative St where ---------------------------------------------------- -- common functions +{-# INLINABLE aToken #-} +aToken :: Coin -> St Coin +aToken coin = do + mCoin <- gets (\st -> toLendingToken st coin) + maybe err pure mCoin + where + err = throwError "Coin not supported" + {-# INLINABLE guardError #-} -- | Execute further if condition is True or throw error with -- given error message. @@ -168,9 +177,9 @@ modifyReserve coin f = modifyReserve' coin (Right . f) -- | Modify reserve for a given asset. It can throw errors. modifyReserve' :: Coin -> (Reserve -> Either Error Reserve) -> St () modifyReserve' asset f = do - LendingPool lp users curSym <- get + LendingPool lp users curSym coinMap <- get case M.lookup asset lp of - Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym) (f reserve) + Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym coinMap) (f reserve) Nothing -> throwError $ "Asset is not supported" {-# INLINABLE modifyUser #-} @@ -182,10 +191,10 @@ modifyUser uid f = modifyUser' uid (Right . f) -- | Modify user info by id. It can throw errors. modifyUser' :: UserId -> (User -> Either Error User) -> St () modifyUser' uid f = do - LendingPool lp users curSym <- get + LendingPool lp users curSym coinMap <- get case f $ fromMaybe defaultUser $ M.lookup uid users of Left msg -> throwError msg - Right user -> put $ LendingPool lp (M.insert uid user users) curSym + Right user -> put $ LendingPool lp (M.insert uid user users) curSym coinMap {-# INLINABLE modifyWalletAndReserve #-} -- | Modify user wallet and reserve wallet with the same function. diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index eeda88cdd..c1cf9678f 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -20,6 +20,7 @@ module Mlabs.Lending.Logic.Types( , UserId(..) , Reserve(..) , InterestRate(..) + , CoinCfg(..) , initReserve , initLendingPool , Act(..) @@ -30,6 +31,8 @@ module Mlabs.Lending.Logic.Types( , LpAddressesProviderRegistry(..) , Coin , toLendingToken + , fromLendingToken + , fromAToken , LpCollateralManager(..) , LpConfigurator(..) , PriceOracleProvider(..) @@ -70,7 +73,8 @@ instance Eq UserId where data LendingPool = LendingPool { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app - , lp'currency :: !CurrencySymbol + , lp'currency :: !CurrencySymbol -- ^ main correncySymbol of the app + , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins } deriving (Show, Generic) @@ -80,26 +84,38 @@ data Reserve = Reserve { reserve'wallet :: !Wallet -- ^ total amounts of coins deposited to reserve , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin + , reserve'aToken :: !TokenName -- ^ aToken coressponding to the coin of the reserve } deriving (Show, Generic) +-- | Coin configuration +data CoinCfg = CoinCfg + { coinCfg'coin :: Coin + , coinCfg'rate :: Rational + , coinCfg'aToken :: TokenName + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + {-# INLINABLE initLendingPool #-} -initLendingPool :: CurrencySymbol -> [(Coin, Rational)] -> LendingPool -initLendingPool curSym coins = LendingPool reserves M.empty curSym +initLendingPool :: CurrencySymbol -> [CoinCfg] -> LendingPool +initLendingPool curSym coinCfgs = LendingPool reserves M.empty curSym coinMap where - reserves = M.fromList $ fmap (\(coin, rat) -> (coin, initReserve rat)) coins + reserves = M.fromList $ fmap (\cfg -> (coinCfg'coin cfg, initReserve cfg)) coinCfgs + coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken) -> (aToken, coin)) coinCfgs {-# INLINABLE initReserve #-} -- | Initialise empty reserve with given ratio of its coin to ada -initReserve :: Rational -> Reserve -initReserve rate = Reserve +initReserve :: CoinCfg -> Reserve +initReserve CoinCfg{..} = Reserve { reserve'wallet = Wallet { wallet'deposit = 0 , wallet'borrow = 0 , wallet'collateral = 0 } - , reserve'rate = rate + , reserve'rate = coinCfg'rate , reserve'liquidationThreshold = 8 % 10 + , reserve'aToken = coinCfg'aToken } -- | User is a set of wallets per currency @@ -185,7 +201,7 @@ data UserAct -- | Acts that can be done by admin users. data GovernAct - = AddReserve Coin Rational -- ^ Adds new reserve + = AddReserve CoinCfg -- ^ Adds new reserve deriving stock (Show, Generic) deriving anyclass (FromJSON, ToJSON) @@ -200,9 +216,17 @@ data PriceAct type Coin = AssetClass {-# INLINABLE toLendingToken #-} -toLendingToken :: CurrencySymbol -> Coin -> Coin -toLendingToken lendingPoolCurrency (AssetClass (cs, tn)) = - AssetClass (lendingPoolCurrency, TokenName $ concatenate (unCurrencySymbol cs) (unTokenName tn)) +toLendingToken :: LendingPool -> Coin -> Maybe Coin +toLendingToken LendingPool{..} coin = + flip fmap (M.lookup coin lp'reserves) $ \Reserve{..} -> AssetClass (lp'currency, reserve'aToken) + +{-# INLINABLE fromAToken #-} +fromAToken :: LendingPool -> TokenName -> Maybe Coin +fromAToken LendingPool{..} tn = M.lookup tn lp'coinMap + +{-# INLINABLE fromLendingToken #-} +fromLendingToken :: LendingPool -> Coin -> Maybe Coin +fromLendingToken lp (AssetClass (_ ,tn)) = fromAToken lp tn ---------------------------------------------------- -- some types specific to aave @@ -227,6 +251,7 @@ data InterestRate = StableRate | VariableRate ------------------------------------------ +PlutusTx.unstableMakeIsData ''CoinCfg PlutusTx.unstableMakeIsData ''InterestRate PlutusTx.unstableMakeIsData ''UserAct PlutusTx.unstableMakeIsData ''PriceAct diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index eb4a3288e..f273097d5 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -5,7 +5,7 @@ module Test.Lending.Contract( import Prelude -import Data.Default +-- import Data.Default import Test.Tasty import Test.Tasty.HUnit @@ -18,7 +18,7 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified PlutusTx.Ratio as R -import Mlabs.Lending.Logic.Types (Coin, UserAct(..), InterestRate(..)) +import Mlabs.Lending.Logic.Types (Coin, UserAct(..), InterestRate(..), CoinCfg(..)) import qualified Mlabs.Lending.Logic.App as L import qualified Mlabs.Lending.Contract.Lendex as L @@ -32,17 +32,20 @@ test = testGroup "Contract" where testDeposit = testNoErrors initConfig depositScript testBorrow = do - Trace.runEmulatorTraceIO' def initConfig borrowScript + -- uncomment to see the trace of execution + -- Trace.runEmulatorTraceIO' def initConfig borrowScript testNoErrors initConfig borrowScript -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. depositScript :: Trace.EmulatorTrace () depositScript = do L.callStartLendex w1 $ L.StartParams - { sp'coins = fmap (, R.fromInteger 1) [adaCoin, coin1, coin2, coin3] } + { sp'coins = fmap (\(coin, aCoin) -> CoinCfg coin (R.fromInteger 1) aCoin) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] } wait 5 userAct1 $ DepositAct 50 coin1 + next userAct2 $ DepositAct 50 coin2 + next userAct3 $ DepositAct 50 coin3 next @@ -84,6 +87,12 @@ coin1 = L.toCoin "Dollar" coin2 = L.toCoin "Euro" coin3 = L.toCoin "Lira" +aToken1, aToken2, aToken3, aAda :: Value.TokenName +aToken1 = Value.tokenName "aDollar" +aToken2 = Value.tokenName "aEuro" +aToken3 = Value.tokenName "aLira" +aAda = Value.tokenName "aAda" + adaCoin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) -- | Initial config diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 0b6d790a4..dedd43b51 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -33,18 +33,18 @@ test = testGroup "User actions" where testBorrow = testWallets [(user1, w1)] borrowScript where - w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 30), (aToken coin1, 0)] + w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 30), (fromToken aToken1, 0)] - testDeposit = testWallets [(user1, wal coin1), (user2, wal coin2), (user3, wal coin3)] depositScript + testDeposit = testWallets [(user1, wal coin1 aToken1), (user2, wal coin2 aToken2), (user3, wal coin3 aToken3)] depositScript where - wal coin = BchWallet $ M.fromList [(coin, 50), (aToken coin, 50)] + wal coin aToken = BchWallet $ M.fromList [(coin, 50), (fromToken aToken, 50)] testBorrowNoCollateral = testScript borrowNoCollateralScript @=? False testBorrowNotEnoughCollateral = testScript borrowNotEnoughCollateralScript @=? False testWithdraw = testWallets [(user1, w1)] withdrawScript where - w1 = BchWallet $ M.fromList [(coin1, 75), (aToken coin1, 25)] + w1 = BchWallet $ M.fromList [(coin1, 75), (fromToken aToken1, 25)] -- User: -- * deposits 50 coin1 @@ -58,7 +58,7 @@ test = testGroup "User actions" -- aToken - 0 = remaining from collateral testRepay = testWallets [(user1, w1)] repayScript where - w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 10), (aToken coin1, 0)] + w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 10), (fromToken aToken1, 0)] -- | Checks that script runs without errors testScript :: [Act] -> Bool @@ -156,8 +156,8 @@ repayScript = mconcat --------------------------------- -- constants -aToken :: Coin -> Coin -aToken = toLendingToken lendingPoolCurrency +fromToken :: TokenName -> Coin +fromToken aToken = AssetClass (lendingPoolCurrency, aToken) lendingPoolCurrency :: CurrencySymbol lendingPoolCurrency = currencySymbol "lending-pool" @@ -174,18 +174,24 @@ coin1 = toCoin "Dollar" coin2 = toCoin "Euro" coin3 = toCoin "Lira" +aToken1, aToken2, aToken3 :: TokenName +aToken1 = tokenName "aDollar" +aToken2 = tokenName "aEuro" +aToken3 = tokenName "aLira" + -- | Default application. -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. testAppConfig :: AppConfig testAppConfig = AppConfig reserves users lendingPoolCurrency where - reserves = fmap (, R.fromInteger 1) [coin1, coin2, coin3] + reserves = fmap (\(coin, aCoin) -> CoinCfg coin (R.fromInteger 1) aCoin) + [(coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] + users = [ (user1, wal (coin1, 100)) , (user2, wal (coin2, 100)) , (user3, wal (coin3, 100)) ] - wal cs = BchWallet $ uncurry M.singleton cs From 216967f7274f477c9e8ef50f878f796001347bf3 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 12 May 2021 16:33:24 +0300 Subject: [PATCH 24/81] Rewrite two tests to plutus unit tests --- mlabs/mlabs-plutus-use-cases.cabal | 2 + mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 7 ++- mlabs/test/Test/Lending/Contract.hs | 69 +++++++++++++++------- mlabs/test/Test/Lending/Scene.hs | 44 ++++++++++++++ mlabs/test/Test/Utils.hs | 16 +++-- 5 files changed, 106 insertions(+), 32 deletions(-) create mode 100644 mlabs/test/Test/Lending/Scene.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 7a67498bb..6423b0b00 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -107,6 +107,7 @@ Test-suite mlabs-plutus-use-cases-tests Default-Language: Haskell2010 Build-Depends: base >=4.9 && <5 , data-default + , lens , mlabs-plutus-use-cases , containers , playground-common @@ -129,6 +130,7 @@ Test-suite mlabs-plutus-use-cases-tests -- Test.Lending Test.Lending.Contract Test.Lending.Logic + Test.Lending.Scene Test.Utils default-extensions: RecordWildCards diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index fd16d7aa9..d07e97b52 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -16,6 +16,8 @@ module Mlabs.Lending.Contract.Lendex( , callPriceOracleAct , callGovernAct , callStartLendex + , userAction + , startLendex ) where import qualified Prelude as P @@ -50,8 +52,7 @@ import Plutus.Trace.Emulator (EmulatorTrace, callEndpoint, activateContractWalle import qualified Wallet.Emulator as Emulator import qualified Data.Map as M - -import Data.Text.Prettyprint.Doc.Extras +-- import Data.Text.Prettyprint.Doc.Extras type Lendex = SM.StateMachine LendingPool Act @@ -124,7 +125,7 @@ userAction act = do Left _err -> logError ("Action failed" :: String) Right SM.StateMachineTransition{smtConstraints=constraints', smtLookups=lookups'} -> do tx <- submitTxConstraintsWith (lookups P.<> lookups') (constraints P.<> constraints') - mapM_ (logInfo @String) (lines $ show $ pretty tx) + -- mapM_ (logInfo @String) (lines $ show $ pretty tx) awaitTxConfirmed (txId tx) -- | Endpoints for user diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index f273097d5..d5f45a145 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -6,10 +6,11 @@ module Test.Lending.Contract( import Prelude -- import Data.Default +import Control.Lens import Test.Tasty -import Test.Tasty.HUnit +import Plutus.V1.Ledger.Value (Value, TokenName) import qualified Plutus.V1.Ledger.Ada as Ada import qualified Plutus.V1.Ledger.Value as Value import qualified Data.Map as M @@ -21,25 +22,42 @@ import qualified PlutusTx.Ratio as R import Mlabs.Lending.Logic.Types (Coin, UserAct(..), InterestRate(..), CoinCfg(..)) import qualified Mlabs.Lending.Logic.App as L import qualified Mlabs.Lending.Contract.Lendex as L +import qualified Mlabs.Lending.Contract.Forge as Forge import Test.Utils +import Test.Lending.Scene + +depositScene :: Scene +depositScene = appOwns mempty + <> mconcat + [ user w1 coin1 aCoin1 + , user w2 coin2 aCoin2 + , user w3 coin3 aCoin3 ] + where + user wal coin aCoin = wal `owns` [(coin, -50), (aCoin, 50)] + +borrowScene :: Scene +borrowScene = depositScene <> borrowChange + where + borrowChange = w1 `owns` [(aCoin1, -50), (coin2, 30)] + + test :: TestTree test = testGroup "Contract" - [ testCase "Deposit" testDeposit - , testCase "Borrow" testBorrow + [ testDeposit + , testBorrow ] where - testDeposit = testNoErrors initConfig depositScript - testBorrow = do - -- uncomment to see the trace of execution - -- Trace.runEmulatorTraceIO' def initConfig borrowScript - testNoErrors initConfig borrowScript + check msg scene = checkPredicateOptions checkOptions msg (checkScene scene) + + testDeposit = check "Deposit" depositScene depositScript + testBorrow = check "Borrow" borrowScene borrowScript -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. depositScript :: Trace.EmulatorTrace () depositScript = do - L.callStartLendex w1 $ L.StartParams + L.callStartLendex wAdmin $ L.StartParams { sp'coins = fmap (\(coin, aCoin) -> CoinCfg coin (R.fromInteger 1) aCoin) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] } wait 5 userAct1 $ DepositAct 50 coin1 @@ -70,8 +88,12 @@ borrowScript = do ------------------------------------------------------------------------------------ -- init blockchain state +checkOptions :: CheckOptions +checkOptions = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution + -- | Wallets that are used for testing. -w1, w2, w3 :: Wallet +wAdmin, w1, w2, w3 :: Wallet +wAdmin = Wallet 50 w1 = Wallet 1 w2 = Wallet 2 w3 = Wallet 3 @@ -87,7 +109,7 @@ coin1 = L.toCoin "Dollar" coin2 = L.toCoin "Euro" coin3 = L.toCoin "Lira" -aToken1, aToken2, aToken3, aAda :: Value.TokenName +aToken1, aToken2, aToken3, aAda :: TokenName aToken1 = Value.tokenName "aDollar" aToken2 = Value.tokenName "aEuro" aToken3 = Value.tokenName "aLira" @@ -95,16 +117,22 @@ aAda = Value.tokenName "aAda" adaCoin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) --- | Initial config -initConfig :: Trace.EmulatorConfig -initConfig = cfg - where - cfg = Trace.EmulatorConfig $ Left $ M.fromList - [ (w1, val 1000 <> v1 100) - , (w2, val 1000 <> v2 100) - , (w3, val 1000 <> v3 100) - ] +fromToken :: TokenName -> Coin +fromToken aToken = Value.AssetClass (Forge.currencySymbol, aToken) + +aCoin1, aCoin2, aCoin3 :: Coin +aCoin1 = fromToken aToken1 +aCoin2 = fromToken aToken2 +aCoin3 = fromToken aToken3 +initialDistribution :: M.Map Wallet Value +initialDistribution = M.fromList + [ (wAdmin, val 1000) + , (w1, val 1000 <> v1 100) + , (w2, val 1000 <> v2 100) + , (w3, val 1000 <> v3 100) + ] + where val x = Value.singleton Ada.adaSymbol Ada.adaToken x coinVal coin = uncurry Value.singleton (Value.unAssetClass coin) @@ -112,3 +140,4 @@ initConfig = cfg v2 = coinVal coin2 v3 = coinVal coin3 + diff --git a/mlabs/test/Test/Lending/Scene.hs b/mlabs/test/Test/Lending/Scene.hs new file mode 100644 index 000000000..0ca87240b --- /dev/null +++ b/mlabs/test/Test/Lending/Scene.hs @@ -0,0 +1,44 @@ +-- | Set of balances for tests +module Test.Lending.Scene( + Scene(..) + , owns + , appOwns + , checkScene + , coinDiff +) where + +import Data.Map (Map) +import Plutus.V1.Ledger.Value (Value) +import Plutus.Contract.Test hiding (tx) +import Mlabs.Lending.Logic.Types (Coin) +import qualified Plutus.V1.Ledger.Value as Value +import qualified Data.Map as M + +import Test.Utils + +-- | Scene is users with balances and value that is owned by application script +data Scene = Scene + { scene'users :: Map Wallet Value -- ^ user balances + , scene'app :: Value -- ^ application script balance + } + +instance Semigroup Scene where + Scene us1 e1 <> Scene us2 e2 = Scene (M.unionWith (<>) us1 us2) (e1 <> e2) + +instance Monoid Scene where + mempty = Scene mempty mempty + +owns :: Wallet -> [(Coin, Integer)] -> Scene +owns wal ds = Scene { scene'users = M.singleton wal (coinDiff ds), scene'app = mempty } + +appOwns :: [(Coin, Integer)] -> Scene +appOwns v = Scene { scene'users = mempty, scene'app = coinDiff v } + +checkScene :: Scene -> TracePredicate +checkScene Scene{..} = + (concatPredicates $ fmap (uncurry walletFundsChange) $ M.toList scene'users) + .&&. assertNoFailedTransactions + +coinDiff :: [(Coin, Integer)] -> Value +coinDiff = foldMap (uncurry Value.assetClassValue) + diff --git a/mlabs/test/Test/Utils.hs b/mlabs/test/Test/Utils.hs index 899ca195f..eb203ffd6 100644 --- a/mlabs/test/Test/Utils.hs +++ b/mlabs/test/Test/Utils.hs @@ -2,14 +2,15 @@ module Test.Utils( throwError , next , wait - , testNoErrors + , concatPredicates ) where import Data.Functor (void) -import Test.Tasty.HUnit (assertFailure) +import Plutus.Contract.Test import qualified Plutus.Trace.Emulator as Trace +import qualified Data.List as L -- | Throws error to emulator trace. throwError :: String -> Trace.EmulatorTrace a @@ -23,10 +24,7 @@ next = void Trace.nextSlot wait :: Integer -> Trace.EmulatorTrace () wait = void . Trace.waitNSlots . fromInteger --- | Check that there are no errors during execution of the script. -testNoErrors :: Trace.EmulatorConfig -> Trace.EmulatorTrace () -> IO () -testNoErrors cfg trace = case err of - Just e -> assertFailure $ show e - Nothing -> pure () - where - err = (\(_, merr, _) -> merr) $ Trace.runEmulatorTrace cfg trace +concatPredicates :: [TracePredicate] -> TracePredicate +concatPredicates = L.foldl1' (.&&.) + + From 4154ded15c0f7608d4cc4ec9b63d469a78983ef9 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 13 May 2021 12:36:28 +0300 Subject: [PATCH 25/81] Completes unit tests for lendex in plutus setting --- mlabs/mlabs-plutus-use-cases.cabal | 1 + mlabs/src/Mlabs/Lending/Contract/Forge.hs | 30 ++-- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 3 +- mlabs/src/Mlabs/Lending/Logic/React.hs | 7 +- mlabs/test/Test/Lending/Contract.hs | 193 ++++++++++++--------- mlabs/test/Test/Lending/Init.hs | 88 ++++++++++ mlabs/test/Test/Lending/Logic.hs | 5 +- mlabs/test/Test/Lending/Scene.hs | 38 +++- 8 files changed, 261 insertions(+), 104 deletions(-) create mode 100644 mlabs/test/Test/Lending/Init.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 6423b0b00..c060761d8 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -129,6 +129,7 @@ Test-suite mlabs-plutus-use-cases-tests Other-modules: -- Test.Lending Test.Lending.Contract + Test.Lending.Init Test.Lending.Logic Test.Lending.Scene Test.Utils diff --git a/mlabs/src/Mlabs/Lending/Contract/Forge.hs b/mlabs/src/Mlabs/Lending/Contract/Forge.hs index 24dd72980..2d8002ce0 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Forge.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Forge.hs @@ -41,8 +41,10 @@ data Input = Input -- For burn case we check that: -- -- * user deposit has diminished properly on user's internal wallet for leding pool state --- * user has paid enough aTokens to script -- * script has paid enough real tokens to the use rin return +-- +-- Note that during burn user does not pay aTokens to the app they just get burned. +-- Only app pays to user in compensation for burn. validate :: ScriptContext -> Bool validate ctx = case (getInState, getOutState) of (Just st1, Just st2) -> all (isValidForge st1 st2) $ Value.flattenValue $ txInfoForge info @@ -84,7 +86,8 @@ validate ctx = case (getInState, getOutState) of -- checks that user deposit becomes larger on given amount of minted tokens -- and user pays given amount to the lending app. We go through the list of all signatures -- to see if anyone acts as a user (satisfy constraints). - isValidMint (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = any checkUserMint users + isValidMint (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = + traceIfFalse "No user is allowed to mint" $ any checkUserMint users where checkUserMint uid = checkUserDepositDiff uid @@ -92,31 +95,32 @@ validate ctx = case (getInState, getOutState) of && checkScriptPays uid -- Check that user balance has growed on user inner wallet deposit - checkUserDepositDiff = checkUserDepositDiffBy (\dep1 dep2 -> dep2 - dep1 == amount) st1 st2 coin + checkUserDepositDiff uid = traceIfFalse "User deposit has not growed after Mint" $ + checkUserDepositDiffBy (\dep1 dep2 -> dep2 - dep1 == amount) st1 st2 coin uid -- Check that user payed value to script. -- We check that state value became bigger after state transition. - checkUserPays = stVal2 == (stVal1 <> Value.assetClassValue coin amount) + checkUserPays = traceIfFalse "User does not pay for Mint" $ + stVal2 == (stVal1 <> Value.assetClassValue coin amount) -- Check that user recieved aCoins - checkScriptPays uid = checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue aCoin amount :: TxConstraints () ()) ctx + checkScriptPays uid = traceIfFalse "User has not received aCoins for Mint" $ + checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue aCoin amount :: TxConstraints () ()) ctx - isValidBurn (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = any checkUserBurn users + isValidBurn (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = + traceIfFalse "No user is allowed to burn" $ any checkUserBurn users where checkUserBurn uid = checkUserDepositDiff uid - && checkUserPays && checkScriptPays uid -- Check that user balance has diminished on user inner wallet deposit - checkUserDepositDiff = checkUserDepositDiffBy (\dep1 dep2 -> dep1 - dep2 == amount) st1 st2 coin - - -- Check that user payed value to script. - -- We check that state value became bigger after state transition - checkUserPays = stVal2 == (stVal1 <> Value.assetClassValue aCoin amount) + checkUserDepositDiff uid = traceIfFalse "User deposit has not diminished after Burn" $ + checkUserDepositDiffBy (\dep1 dep2 -> dep1 - dep2 == amount) st1 st2 coin uid -- Check that user recieved coins - checkScriptPays uid = checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue coin amount :: TxConstraints () ()) ctx + checkScriptPays uid = traceIfFalse "User does not receive for Burn" $ + checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue coin amount :: TxConstraints () ()) ctx -- check change of the user deposit for state prior to transition (st1) and after transition (st2) checkUserDepositDiffBy cond st1 st2 coin uid = either (const False) id $ do diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index d07e97b52..4714affb7 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -1,7 +1,8 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} module Mlabs.Lending.Contract.Lendex( - mkValidator + lendexAddress + , mkValidator , scriptInstance -- * Endpoints , UserLendexSchema, UserApp diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index ed5e47c9d..972248e77 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -10,6 +10,8 @@ module Mlabs.Lending.Logic.React( react ) where +import qualified Prelude as Hask + import qualified PlutusTx.Ratio as R import qualified PlutusTx.Numeric as N import PlutusTx.Prelude @@ -156,8 +158,9 @@ react = \case modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount } aCoin <- aToken asset pure $ mconcat - [ moveFromTo uid Self aCoin amount - , moveFromTo Self uid asset amount + [ moveFromTo Self uid asset amount + , moveFromTo uid Self aCoin amount + , Hask.pure $ Burn aCoin amount ] hasEnoughDepositToWithdraw uid amount asset = do diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index d5f45a145..00816730c 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -5,54 +5,41 @@ module Test.Lending.Contract( import Prelude --- import Data.Default -import Control.Lens - import Test.Tasty -import Plutus.V1.Ledger.Value (Value, TokenName) -import qualified Plutus.V1.Ledger.Ada as Ada -import qualified Plutus.V1.Ledger.Value as Value -import qualified Data.Map as M - import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified PlutusTx.Ratio as R -import Mlabs.Lending.Logic.Types (Coin, UserAct(..), InterestRate(..), CoinCfg(..)) -import qualified Mlabs.Lending.Logic.App as L +import Mlabs.Lending.Logic.Types (UserAct(..), InterestRate(..), CoinCfg(..)) import qualified Mlabs.Lending.Contract.Lendex as L -import qualified Mlabs.Lending.Contract.Forge as Forge import Test.Utils +import Test.Lending.Init import Test.Lending.Scene -depositScene :: Scene -depositScene = appOwns mempty - <> mconcat - [ user w1 coin1 aCoin1 - , user w2 coin2 aCoin2 - , user w3 coin3 aCoin3 ] - where - user wal coin aCoin = wal `owns` [(coin, -50), (aCoin, 50)] - -borrowScene :: Scene -borrowScene = depositScene <> borrowChange - where - borrowChange = w1 `owns` [(aCoin1, -50), (coin2, 30)] - - test :: TestTree test = testGroup "Contract" [ testDeposit , testBorrow + , testBorrowNoCollateral + , testBorrowNotEnoughCollateral + , testWithdraw + , testRepay ] where check msg scene = checkPredicateOptions checkOptions msg (checkScene scene) - testDeposit = check "Deposit" depositScene depositScript + testDeposit = check "Deposit (can mint aTokens)" depositScene depositScript testBorrow = check "Borrow" borrowScene borrowScript + testBorrowNoCollateral = check "Borrow without collateral" borrowWithoutCollateralScene borrowWithoutCollateralScript + testBorrowNotEnoughCollateral = check "Borrow with not enough collateral" borrowNotEnoughCollateralScene borrowNotEnoughCollateralScript + testWithdraw = check "Withdraw (can burn aTokens)" withdrawScene withdrawScript + testRepay = check "Repay" repayScene repayScript + +-------------------------------------------------------------------------------- +-- deposit test -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. depositScript :: Trace.EmulatorTrace () @@ -67,6 +54,19 @@ depositScript = do userAct3 $ DepositAct 50 coin3 next +depositScene :: Scene +depositScene = mconcat + [ appAddress L.lendexAddress + , appOwns [(coin1, 50), (coin2, 50), (coin3, 50)] + , user w1 coin1 aCoin1 + , user w2 coin2 aCoin2 + , user w3 coin3 aCoin3 ] + where + user wal coin aCoin = wal `owns` [(coin, -50), (aCoin, 50)] + +-------------------------------------------------------------------------------- +-- borrow test + -- | 3 users deposit 50 coins to lending app -- and first user borrows in coin2 that he does not own prior to script run. borrowScript :: Trace.EmulatorTrace () @@ -85,59 +85,94 @@ borrowScript = do } next ------------------------------------------------------------------------------------- --- init blockchain state - -checkOptions :: CheckOptions -checkOptions = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution - --- | Wallets that are used for testing. -wAdmin, w1, w2, w3 :: Wallet -wAdmin = Wallet 50 -w1 = Wallet 1 -w2 = Wallet 2 -w3 = Wallet 3 - -userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () -userAct1 = L.callUserAct w1 -userAct2 = L.callUserAct w2 -userAct3 = L.callUserAct w3 - --- coins -adaCoin, coin1, coin2, coin3 :: Coin -coin1 = L.toCoin "Dollar" -coin2 = L.toCoin "Euro" -coin3 = L.toCoin "Lira" - -aToken1, aToken2, aToken3, aAda :: TokenName -aToken1 = Value.tokenName "aDollar" -aToken2 = Value.tokenName "aEuro" -aToken3 = Value.tokenName "aLira" -aAda = Value.tokenName "aAda" - -adaCoin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) - -fromToken :: TokenName -> Coin -fromToken aToken = Value.AssetClass (Forge.currencySymbol, aToken) - -aCoin1, aCoin2, aCoin3 :: Coin -aCoin1 = fromToken aToken1 -aCoin2 = fromToken aToken2 -aCoin3 = fromToken aToken3 - -initialDistribution :: M.Map Wallet Value -initialDistribution = M.fromList - [ (wAdmin, val 1000) - , (w1, val 1000 <> v1 100) - , (w2, val 1000 <> v2 100) - , (w3, val 1000 <> v3 100) - ] +borrowScene :: Scene +borrowScene = depositScene <> borrowChange where - val x = Value.singleton Ada.adaSymbol Ada.adaToken x + borrowChange = mconcat + [ w1 `owns` [(aCoin1, -50), (coin2, 30)] + , appOwns [(aCoin1, 50), (coin2, -30)] + ] - coinVal coin = uncurry Value.singleton (Value.unAssetClass coin) - v1 = coinVal coin1 - v2 = coinVal coin2 - v3 = coinVal coin3 +-------------------------------------------------------------------------------- +-- borrow without collateral test (It should fail to borrow) +-- | 3 users deposit 50 coins to lending app +-- and first user borrows in coin2 that he does not own prior to script run. +-- But it should fail because user does not set his deposit funds as collateral. +borrowWithoutCollateralScript :: Trace.EmulatorTrace () +borrowWithoutCollateralScript = do + depositScript + next + userAct1 $ BorrowAct + { act'asset = coin2 + , act'amount = 30 + , act'rate = StableRate + } + next + +borrowWithoutCollateralScene :: Scene +borrowWithoutCollateralScene = depositScene + +-------------------------------------------------------------------------------- +-- borrow without not enough collateral test (It should fail to borrow) + +-- | 3 users deposit 50 coins to lending app +-- and first user wants to borrow too much. +-- Only allocation of collateral succeeds for the first user but borrow step should fail. +borrowNotEnoughCollateralScript :: Trace.EmulatorTrace () +borrowNotEnoughCollateralScript = do + depositScript + userAct1 SetUserReserveAsCollateralAct + { act'asset = coin1 + , act'useAsCollateral = True + , act'portion = R.fromInteger 1 + } + next + userAct1 BorrowAct + { act'asset = coin2 + , act'amount = 60 + , act'rate = StableRate + } + next + +-- | Only allocation of collateral succeeds but borrow step should fail. +borrowNotEnoughCollateralScene :: Scene +borrowNotEnoughCollateralScene = depositScene <> setCollateralChange + where + setCollateralChange = mconcat [ w1 `owns` [(aCoin1, -50)], appOwns [(aCoin1, 50)]] + +-------------------------------------------------------------------------------- +-- withdraw test + +-- | User1 deposits 50 out of 100 and gets back 25. +-- So we check that user has 75 coins and 25 aCoins +withdrawScript :: Trace.EmulatorTrace () +withdrawScript = do + depositScript + userAct1 WithdrawAct + { act'amount = 25 + , act'asset = coin1 + } + +withdrawScene :: Scene +withdrawScene = depositScene <> withdrawChange + where + withdrawChange = mconcat [ w1 `owns` [(aCoin1, -25), (coin1, 25)], appOwns [(coin1, -25)] ] + +-------------------------------------------------------------------------------- +-- repay test + +repayScript :: Trace.EmulatorTrace () +repayScript = do + borrowScript + userAct1 $ RepayAct + { act'asset = coin2 + , act'amount = 20 + , act'rate = StableRate + } + +repayScene :: Scene +repayScene = borrowScene <> repayChange + where + repayChange = mconcat [w1 `owns` [(coin2, -20)], appOwns [(coin2, 20)]] diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs new file mode 100644 index 000000000..dc3a08ac0 --- /dev/null +++ b/mlabs/test/Test/Lending/Init.hs @@ -0,0 +1,88 @@ +-- | Init blockchain state for tests +module Test.Lending.Init( + checkOptions + , wAdmin, w1, w2, w3 + , userAct1, userAct2, userAct3 + , adaCoin, coin1, coin2, coin3 + , aAda, aToken1, aToken2, aToken3 + , aCoin1, aCoin2, aCoin3 + , initialDistribution +) where + +import Prelude + +-- import Data.Default +import Control.Lens + +import Plutus.V1.Ledger.Value (Value, TokenName) +import qualified Plutus.V1.Ledger.Ada as Ada +import qualified Plutus.V1.Ledger.Value as Value +import qualified Data.Map as M + +import Plutus.Contract.Test hiding (tx) +import qualified Plutus.Trace.Emulator as Trace + +import Mlabs.Lending.Logic.Types (Coin, UserAct(..)) +import qualified Mlabs.Lending.Logic.App as L +import qualified Mlabs.Lending.Contract.Lendex as L +import qualified Mlabs.Lending.Contract.Forge as Forge + +checkOptions :: CheckOptions +checkOptions = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution + +-- | Wallets that are used for testing. +wAdmin, w1, w2, w3 :: Wallet +wAdmin = Wallet 50 +w1 = Wallet 1 +w2 = Wallet 2 +w3 = Wallet 3 + +-- | Showrtcuts for user actions +userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () +userAct1 = L.callUserAct w1 +userAct2 = L.callUserAct w2 +userAct3 = L.callUserAct w3 + +-- | Coins which are used for testing +adaCoin, coin1, coin2, coin3 :: Coin +coin1 = L.toCoin "Dollar" +coin2 = L.toCoin "Euro" +coin3 = L.toCoin "Lira" + +-- | Corresponding aTokens. We create aTokens in exchange for to the real coins +-- on our lending app +aToken1, aToken2, aToken3, aAda :: TokenName +aToken1 = Value.tokenName "aDollar" +aToken2 = Value.tokenName "aEuro" +aToken3 = Value.tokenName "aLira" +aAda = Value.tokenName "aAda" + +adaCoin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) + +-- | Convert aToken to aCoin +fromToken :: TokenName -> Coin +fromToken aToken = Value.AssetClass (Forge.currencySymbol, aToken) + +-- | aCoins that correspond to real coins +aCoin1, aCoin2, aCoin3 :: Coin +aCoin1 = fromToken aToken1 +aCoin2 = fromToken aToken2 +aCoin3 = fromToken aToken3 + +-- | Initial distribution of wallets for testing +initialDistribution :: M.Map Wallet Value +initialDistribution = M.fromList + [ (wAdmin, val 1000) + , (w1, val 1000 <> v1 100) + , (w2, val 1000 <> v2 100) + , (w3, val 1000 <> v3 100) + ] + where + val x = Value.singleton Ada.adaSymbol Ada.adaToken x + + coinVal coin = uncurry Value.singleton (Value.unAssetClass coin) + v1 = coinVal coin1 + v2 = coinVal coin2 + v3 = coinVal coin3 + + diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index dedd43b51..7d4ce3737 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -22,7 +22,7 @@ noErrors app = null $ app'log app -- | Test suite for a logic of lending application test :: TestTree -test = testGroup "User actions" +test = testGroup "Logic" [ testCase "Deposit" testDeposit , testCase "Borrow" testBorrow , testCase "Borrow without collateral" testBorrowNoCollateral @@ -156,9 +156,11 @@ repayScript = mconcat --------------------------------- -- constants +-- | convert aToken to aCoin fromToken :: TokenName -> Coin fromToken aToken = AssetClass (lendingPoolCurrency, aToken) +-- | Base currency of lending app (it's mock for monetary policy of the lending app) lendingPoolCurrency :: CurrencySymbol lendingPoolCurrency = currencySymbol "lending-pool" @@ -174,6 +176,7 @@ coin1 = toCoin "Dollar" coin2 = toCoin "Euro" coin3 = toCoin "Lira" +-- | aTokens aToken1, aToken2, aToken3 :: TokenName aToken1 = tokenName "aDollar" aToken2 = tokenName "aEuro" diff --git a/mlabs/test/Test/Lending/Scene.hs b/mlabs/test/Test/Lending/Scene.hs index 0ca87240b..2a91bea8d 100644 --- a/mlabs/test/Test/Lending/Scene.hs +++ b/mlabs/test/Test/Lending/Scene.hs @@ -3,11 +3,15 @@ module Test.Lending.Scene( Scene(..) , owns , appOwns + , appAddress , checkScene , coinDiff ) where +import Control.Applicative (Alternative(..)) + import Data.Map (Map) +import Plutus.V1.Ledger.Address (Address) import Plutus.V1.Ledger.Value (Value) import Plutus.Contract.Test hiding (tx) import Mlabs.Lending.Logic.Types (Coin) @@ -16,29 +20,47 @@ import qualified Data.Map as M import Test.Utils --- | Scene is users with balances and value that is owned by application script +-- | Scene is users with balances and value that is owned by application script. +-- It can be built with Monoid instance from parts with handy functions: +-- +-- owns, apOwns, appAddress +-- +-- With monoid instance we can specify only differences between test stages +-- and then add them app with @<>@ to the initial state of the scene. data Scene = Scene - { scene'users :: Map Wallet Value -- ^ user balances - , scene'app :: Value -- ^ application script balance + { scene'users :: Map Wallet Value -- ^ user balances + , scene'appValue :: Value -- ^ application script balance + , scene'appAddress :: Maybe Address -- ^ address of the app } instance Semigroup Scene where - Scene us1 e1 <> Scene us2 e2 = Scene (M.unionWith (<>) us1 us2) (e1 <> e2) + Scene us1 e1 maddr1 <> Scene us2 e2 maddr2 = + Scene (M.unionWith (<>) us1 us2) (e1 <> e2) (maddr1 <|> maddr2) instance Monoid Scene where - mempty = Scene mempty mempty + mempty = Scene mempty mempty Nothing +-- | Creates scene with single user in it that owns so many coins, app owns zero coins. owns :: Wallet -> [(Coin, Integer)] -> Scene -owns wal ds = Scene { scene'users = M.singleton wal (coinDiff ds), scene'app = mempty } +owns wal ds = Scene { scene'users = M.singleton wal (coinDiff ds), scene'appValue = mempty, scene'appAddress = Nothing } +-- | Creates scene with no users and app owns given amount of coins. appOwns :: [(Coin, Integer)] -> Scene -appOwns v = Scene { scene'users = mempty, scene'app = coinDiff v } +appOwns v = Scene { scene'users = mempty, scene'appValue = coinDiff v, scene'appAddress = Nothing } + +-- | Creates scene with no users and app owns given amount of coins. +appAddress :: Address -> Scene +appAddress addr = Scene { scene'users = mempty, scene'appValue = mempty, scene'appAddress = Just addr } +-- | Truns scene to plutus checks. Every user ownership turns into walletFundsChange check. checkScene :: Scene -> TracePredicate -checkScene Scene{..} = +checkScene Scene{..} = withAddressCheck $ (concatPredicates $ fmap (uncurry walletFundsChange) $ M.toList scene'users) .&&. assertNoFailedTransactions + where + withAddressCheck = maybe id (\addr -> (valueAtAddress addr (== scene'appValue) .&&. )) scene'appAddress +-- | Converts list of coins to value. coinDiff :: [(Coin, Integer)] -> Value coinDiff = foldMap (uncurry Value.assetClassValue) From 6ff43a0a4af54f8b4bd7b8073d725f5b3230d260 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 13 May 2021 12:38:54 +0300 Subject: [PATCH 26/81] Removes redundant files --- mlabs/src/Mlabs/Lending.hs | 331 ------------------------------------- mlabs/test/Main.hs | 1 - mlabs/test/Test/Lending.hs | 75 --------- 3 files changed, 407 deletions(-) delete mode 100644 mlabs/src/Mlabs/Lending.hs delete mode 100644 mlabs/test/Test/Lending.hs diff --git a/mlabs/src/Mlabs/Lending.hs b/mlabs/src/Mlabs/Lending.hs deleted file mode 100644 index cf73af469..000000000 --- a/mlabs/src/Mlabs/Lending.hs +++ /dev/null @@ -1,331 +0,0 @@ -{-# OPTIONS_GHC -fno-specialize #-} -{-# OPTIONS_GHC -fno-strictness #-} --- | Lending exchange platform (Lendex for short) is a tool for --- user to provide lending funds. --- --- There are three roles of users: --- --- * **admin** - can initialise whole platform and close it. --- --- * **lender user** can create new tokens on the platform and provide funds with it. --- --- * **borrower user** can borrow funds. -module Mlabs.Lending where - -import PlutusTx.Prelude hiding (Semigroup(..), unless) -import qualified PlutusTx.Prelude as Plutus - -import Control.Monad (forever, void) - -import Data.Monoid (Last(..)) - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -import Ledger hiding (singleton) -import Ledger.Constraints as Constraints -import Ledger.Constraints.OnChain as Constraints -import Ledger.Constraints.TxConstraints as Constraints -import Plutus.Contract -import qualified Plutus.Contracts.Currency as Currency -import qualified PlutusTx -import qualified Ledger.Typed.Scripts as Scripts - -import Playground.Contract (ToSchema) -import qualified Prelude -import Prelude (Semigroup(..)) -import qualified Data.Map as Map -import Text.Printf (printf) -import qualified Plutus.Trace as Trace -import Plutus.Contract.Trace (Wallet) -import Plutus.Trace (EmulatorTrace) -import Mlabs.Lending.Contract.Coin -import Mlabs.Lending.Contract.Utils - -import qualified Data.Text as T - --- | Constants for thread of lendex state and pool state. -lendexTokenName, poolStateTokenName :: TokenName - -lendexTokenName = "Lendex" -poolStateTokenName = "Pool State" - -newtype Lendex = Lendex - { lxCoin :: Coin - } deriving stock (Show, Generic) - deriving anyclass (ToJSON, FromJSON, ToSchema) - deriving newtype (Prelude.Eq, Prelude.Ord) -PlutusTx.makeLift ''Lendex - --- | Available actions -data Action - = Create Coin - -- ^ Create new coin for lending - | Close - -- $ close the exchange - deriving (Show) - -PlutusTx.unstableMakeIsData ''Action -PlutusTx.makeLift ''Action - -type LendingPool = [Coin] - --- | Lending datum -data LendingDatum - = Factory [Coin] - -- ^ Global state to watch for coins that were created. - -- For every new coin we check against this state - -- weather it is new and have not been already created. - | Pool Coin - -- ^ single coint to lend funds. - deriving stock Show - -PlutusTx.unstableMakeIsData ''LendingDatum -PlutusTx.makeLift ''LendingDatum - --- | Parameters for create endpoint -data CreateParams = CreateParams - { cpCoin :: Coin - -- ^ coin for which we create lending capabilities. - } - deriving (Show, Generic, ToJSON, FromJSON, ToSchema) - -{-# INLINABLE mkValidator #-} --- | On-chain script validator -mkValidator :: Lendex -> Coin -> LendingDatum -> Action -> ScriptContext -> Bool -mkValidator lx c dat act ctx = case (dat, act) of - (Factory cs, Create pool) -> validateCreate lx c cs pool ctx - (_, Close ) -> validateClose lx c dat ctx - _ -> False - -{-# INLINABLE validateCreate #-} --- | It validates create-case -validateCreate :: Lendex -> Coin -> [Coin] -> Coin -> ScriptContext -> Bool -validateCreate Lendex{..} poolCoin coins newCoin ctx = - lendexCoinPresent - && newCoinIsAdded - && poolStateCoinForged - && keepsLedexCoin - && keepsPoolStateCoin - where - lendexCoinPresent = - Plutus.traceIfFalse "Lendex coin not present" $ - hasCoinValue (valueWithin $ findOwnInput' ctx) lxCoin - - newCoinIsAdded = - Plutus.traceIfFalse "New coin is added to pool" $ - all (/= newCoin) coins - - poolStateCoinForged = - Plutus.traceIfFalse "Pool state coin not forged" $ - hasCoinValue forged poolCoin - - keepsLedexCoin = keepsCoin (Factory $ newCoin : coins) lxCoin - keepsPoolStateCoin = keepsCoin (Pool newCoin) poolCoin - - keepsCoin st c = Constraints.checkOwnOutputConstraint ctx (OutputConstraint st $ coin c 1) - - forged :: Value - forged = txInfoForge $ scriptContextTxInfo ctx - -{-# INLINABLE validateClose #-} --- | It validates the closing of the whole lending system -validateClose :: Lendex -> Coin -> LendingDatum -> ScriptContext -> Bool -validateClose _ _ _ _ = True - -{-# INLINABLE validateLiquidityForging #-} --- | It validates the forging of new coin for lending purposes -validateLiquidityForging :: Lendex -> TokenName -> ScriptContext -> Bool -validateLiquidityForging us tn ctx = case [ i - | i <- txInfoInputs $ scriptContextTxInfo ctx - , let v = valueWithin i - , hasCoinValue v usC || - hasCoinValue v lpC - ] of - [_] -> True - [_, _] -> True - _ -> Plutus.traceError "pool state forging without Lendex input" - where - usC, lpC :: Coin - usC = lxCoin us - lpC = mkCoin (ownCurrencySymbol ctx) tn - --- | Instance of validation script for lending exchange -lendexInstance :: Lendex -> Scripts.ScriptInstance Lending -lendexInstance lx = Scripts.validator @Lending - ($$(PlutusTx.compile [|| mkValidator ||]) - `PlutusTx.applyCode` PlutusTx.liftCode lx - `PlutusTx.applyCode` PlutusTx.liftCode c) - $$(PlutusTx.compile [|| wrap ||]) - where - c :: Coin - c = poolStateCoin lx - - wrap = Scripts.wrapValidator @LendingDatum @Action - --- | Validator -lendexScript :: Lendex -> Validator -lendexScript = Scripts.validatorScript . lendexInstance - --- | Validator script address -lendexAddress :: Lendex -> Ledger.Address -lendexAddress = Ledger.scriptAddress . lendexScript - --- | Wrapper to create lendex state coin out of @CurrencySymbol@. -lendex :: CurrencySymbol -> Lendex -lendex cs = Lendex $ mkCoin cs lendexTokenName - --- | Constructor for pool state coin. --- It relies on script for new coin forgery validation. -poolStateCoin :: Lendex -> Coin -poolStateCoin = flip mkCoin poolStateTokenName . liquidityCurrency - --- | pool state forgery validator -liquidityPolicy :: Lendex -> MonetaryPolicy -liquidityPolicy lx = mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| \u t -> Scripts.wrapMonetaryPolicy (validateLiquidityForging u t) ||]) - `PlutusTx.applyCode` PlutusTx.liftCode lx - `PlutusTx.applyCode` PlutusTx.liftCode poolStateTokenName - --- | @CurrencySumbol@ for the lendex. We use it for pool state. --- They share common @CurrencySymbol@ -liquidityCurrency :: Lendex -> CurrencySymbol -liquidityCurrency = scriptCurrencySymbol . liquidityPolicy - --- | Provides TxOut that contains lendex script. -findLendexInstance :: Lendex -> Coin -> (LendingDatum -> Maybe a) -> App (TxOutRef, TxOutTx, a) -findLendexInstance us c f = do - let addr = lendexAddress us - logInfo @String $ printf "looking for Lendex instance at address %s containing coin %s " (show addr) (show c) - utxos <- utxoAt addr - go [x | x@(_, o) <- Map.toList utxos, coinValueOf (txOutValue $ txOutTxOut o) c == 1] - where - go [] = throwError "Lendex instance not found" - go ((oref, o) : xs) = do - d <- getLendexDatum o - case f d of - Nothing -> go xs - Just a -> do - logInfo @String $ printf "found Lendex instance with datum: %s" (show d) - return (oref, o, a) - --- | Provides TXOut that contains global state of lendex. --- It provides the list of coins that are part of the exchange so far. -findLendexFactory :: Lendex -> App (TxOutRef, TxOutTx, [Coin]) -findLendexFactory lx@Lendex{..} = findLendexInstance lx lxCoin $ \case - Factory lps -> Just lps - Pool _ -> Nothing - --- | Reads lendex datum for the @TxOut@. -getLendexDatum :: TxOutTx -> App LendingDatum -getLendexDatum 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 - --- | Creates a Lendex "factory". This factory will keep track of the existing --- liquidity pools and enforce that there will be at most one liquidity pool --- for any pair of tokens at any given time. -start :: HasBlockchainActions s => Contract w s Text Lendex -start = do - pkh <- pubKeyHash <$> ownPubKey - cs <- fmap Currency.currencySymbol $ - mapError (T.pack . show @Currency.CurrencyError) $ - Currency.forgeContract pkh [(lendexTokenName, 1)] - let c = mkCoin cs lendexTokenName - us = lendex cs - inst = lendexInstance us - tx = mustPayToTheScript (Factory []) $ coin c 1 - ledgerTx <- submitTxConstraints inst tx - void $ awaitTxConfirmed $ txId ledgerTx - - logInfo @String $ printf "started Uniswap %s at address %s" (show us) (show $ lendexAddress us) - return us - --- | Creates a liquidity pool for a given coin. --- We have no coins at the start -create :: Lendex -> CreateParams -> App () -create lx CreateParams{..} = do - (oref, o, lps) <- findLendexFactory lx - let lp = cpCoin - usInst = lendexInstance lx - usScript = lendexScript lx - usDat1 = Factory $ lp : lps - usDat2 = Pool lp - psC = poolStateCoin lx - usVal = coin (lxCoin lx) 1 - lpVal = coin cpCoin 0 - - lookups = Constraints.scriptInstanceLookups usInst - <> Constraints.otherScript usScript - <> Constraints.monetaryPolicy (liquidityPolicy lx) - <> Constraints.unspentOutputs (Map.singleton oref o) - - tx = Constraints.mustPayToTheScript usDat1 usVal - <> Constraints.mustPayToTheScript usDat2 lpVal - <> Constraints.mustForgeValue (coin psC 1) - <> Constraints.mustSpendScriptOutput oref (Redeemer $ PlutusTx.toData $ Create lp) - - ledgerTx <- submitTxConstraintsWith lookups tx - void $ awaitTxConfirmed $ txId ledgerTx - - logInfo $ "created liquidity pool: " ++ show lp - --- Type to tag Redeemer and Datum for our lending platform -data Lending -instance Scripts.ScriptType Lending where - type RedeemerType Lending = Action - type DatumType Lending = LendingDatum - --- | Schema for the super user who can initiate the whole lendex platform. -type LendingOwnerSchema = - BlockchainActions - .\/ Endpoint "start" () - --- | Schema for lender. -type LendingSchema = - BlockchainActions - .\/ Endpoint "create" CreateParams -- create new coin to lend funds - -type App a = Contract () LendingSchema Text a -type OwnerApp a = Contract () LendingOwnerSchema Text a - --- | Endpoints for admin of the platform. Admin can initialise the lending platform. -ownerEndpoint :: Contract (Last Lendex) LendingOwnerSchema Text () -ownerEndpoint = forever start' - where - start' = - endpoint @"start" >>= \() -> do - lx <- start - tell $ Last $ Just lx - --- | Endpoints for lender -userEndpoints :: Lendex -> App () -userEndpoints lx = forever create' - where - create' = endpoint @"create" >>= create lx - ------------------------------------------------ --- call endpoints (for testing) - --- | Calls init lendex platform for a given wallet. --- Produces tag of the platform that contains coin by which we track --- state of the platform. -callStart :: Wallet -> EmulatorTrace (Maybe Lendex) -callStart w = do - hdl <- Trace.activateContractWallet w ownerEndpoint - void $ Trace.callEndpoint @"start" hdl () - void $ Trace.waitNSlots 10 - Last res <- Trace.observableState hdl - return res - --- | Lendeer calls create coin endpoint. Coin for @CreateParams@ is used for lending purposes. -callCreate :: Lendex -> Wallet -> CreateParams -> EmulatorTrace () -callCreate lx w cp = do - hdl <- Trace.activateContractWallet w (userEndpoints lx) - void $ Trace.callEndpoint @"create" hdl cp - diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index e7c41c366..c5d87662e 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -4,7 +4,6 @@ import Test.Tasty import qualified Test.Lending.Contract as Contract import qualified Test.Lending.Logic as Logic --- import qualified Test.Lending as Lending main :: IO () main = defaultMain $ testGroup "Lending" diff --git a/mlabs/test/Test/Lending.hs b/mlabs/test/Test/Lending.hs deleted file mode 100644 index a10f9604d..000000000 --- a/mlabs/test/Test/Lending.hs +++ /dev/null @@ -1,75 +0,0 @@ --- | Test suite for lending exchange -module Test.Lending( - test -) where - -import Prelude - -import Test.Tasty -import Test.Tasty.HUnit - -import qualified Plutus.V1.Ledger.Ada as Ada -import qualified Plutus.V1.Ledger.Value as Ledger -import qualified Data.Map as M -import qualified PlutusTx.AssocMap as PM - -import Plutus.Contract.Test hiding (tx) -import qualified Plutus.Trace.Emulator as Trace - -import qualified Mlabs.Lending as L -import qualified Mlabs.Lending.Contract.Coin as L - -import Test.Utils - --- | Test suite for lending exchange -test :: TestTree -test = testGroup "Lending" - [ testCreate - ] - --- | Tests for creation of the coin and exchange platform. -testCreate :: TestTree -testCreate = testCase "Create lending pool" $ testNoErrors initConfig createScript - ------------------------------------------------------------------------------------- - --- | Script that creates lendex and one coin for lending. -createScript :: Trace.EmulatorTrace () -createScript = do - mTheLendex <- L.callStart w1 - next - case mTheLendex of - Just theLendex -> do - L.callCreate theLendex w1 $ L.CreateParams - { cpCoin = L.mkCoin currency token - } - next - Nothing -> throwError "No lendex was created" - where - currency = Ledger.currencySymbol "T" - token = Ledger.tokenName "token" - ------------------------------------------------------------------------------------- --- init blockchain state - --- | Wallets that are used for testing. -w1, w2, w3, w4 :: Wallet -w1 = Wallet 1 -w2 = Wallet 2 -w3 = Wallet 3 -w4 = Wallet 4 - --- | Initial config -initConfig :: Trace.EmulatorConfig -initConfig = cfg - where - cfg = Trace.EmulatorConfig $ Left $ M.fromList - [ (w1, v1) - , (w2, v1) - , (w3, v1) - , (w4, v1) - ] - - v1 = val 1000 - val x = Ledger.Value $ PM.fromList [ (Ada.adaSymbol, PM.singleton Ada.adaToken x) ] - From cc16b7d30a17715542a8755428d1c475b971760c Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 14:51:10 +0300 Subject: [PATCH 27/81] Implements first draft of interest rates (aave solution) --- mlabs/mlabs-plutus-use-cases.cabal | 2 + mlabs/src/Mlabs/Lending/Contract/Forge.hs | 2 +- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 4 +- mlabs/src/Mlabs/Lending/Logic/App.hs | 17 ++-- mlabs/src/Mlabs/Lending/Logic/InterestRate.hs | 84 +++++++++++++++++ mlabs/src/Mlabs/Lending/Logic/React.hs | 63 +++++++------ mlabs/src/Mlabs/Lending/Logic/State.hs | 20 ++++ mlabs/src/Mlabs/Lending/Logic/Types.hs | 91 +++++++++++++++---- mlabs/test/Test/Lending/Contract.hs | 11 ++- mlabs/test/Test/Lending/Logic.hs | 35 +++++-- 10 files changed, 259 insertions(+), 70 deletions(-) create mode 100644 mlabs/src/Mlabs/Lending/Logic/InterestRate.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index c060761d8..903406b69 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -50,6 +50,7 @@ library Mlabs.Lending.Contract.Utils Mlabs.Lending.Logic.App Mlabs.Lending.Logic.Emulator + Mlabs.Lending.Logic.InterestRate Mlabs.Lending.Logic.React Mlabs.Lending.Logic.State Mlabs.Lending.Logic.Types @@ -121,6 +122,7 @@ Test-suite mlabs-plutus-use-cases-tests , plutus-use-cases , plutus-contract , prettyprinter + , pretty-show , tasty , tasty-hunit , text diff --git a/mlabs/src/Mlabs/Lending/Contract/Forge.hs b/mlabs/src/Mlabs/Lending/Contract/Forge.hs index 2d8002ce0..0f420681b 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Forge.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Forge.hs @@ -107,7 +107,7 @@ validate ctx = case (getInState, getOutState) of checkScriptPays uid = traceIfFalse "User has not received aCoins for Mint" $ checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue aCoin amount :: TxConstraints () ()) ctx - isValidBurn (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = + isValidBurn (Input st1 _stVal1) (Input st2 _stVal2) coin _aCoin amount = traceIfFalse "No user is allowed to burn" $ any checkUserBurn users where checkUserBurn uid = diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 4714affb7..c692c1817 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -60,7 +60,7 @@ type Lendex = SM.StateMachine LendingPool Act {-# INLINABLE machine #-} machine :: Lendex -machine = SM.mkStateMachine Nothing transition isFinal +machine = (SM.mkStateMachine Nothing transition isFinal) where isFinal = const False @@ -89,7 +89,7 @@ transition :: SM.State LendingPool -> Act -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) -transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of +transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react 0 input) oldData of Left _err -> Nothing Right (resps, newData) -> Just ( foldMap toConstraints resps , SM.State { stateData=newData diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 21e43f92e..a9d6a72c4 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -27,9 +27,10 @@ import qualified PlutusTx.Ratio as R -- | Prototype application data App = App - { app'pool :: !LendingPool -- ^ lending pool - , app'log :: ![Error] -- ^ error log - , app'wallets :: !BchState -- ^ current state of blockchain + { app'pool :: !LendingPool -- ^ lending pool + , app'log :: ![(Act, LendingPool, Error)] -- ^ error log + -- ^ it reports on which act and pool state error has happened + , app'wallets :: !BchState -- ^ current state of blockchain } -- | Lookup state of the blockchain-wallet for a given user-id. @@ -40,16 +41,16 @@ lookupAppWallet uid App{..} = case app'wallets of -- | Runs application with the list of actions. -- Returns final state of the application. runApp :: AppConfig -> [Act] -> App -runApp cfg acts = foldl' go (initApp cfg) acts +runApp cfg acts = foldl' go (initApp cfg) $ zip [0..] acts where -- There are two possible sources of errors: -- * we can not make transition to state (react produces Left) -- * the transition produces action on blockchain that leads to negative balances (applyResp produces Left) - go (App lp errs wallets) act = case runStateT (react act) lp of + go (App lp errs wallets) (timestamp, act) = case runStateT (react timestamp act) lp of Right (resp, nextState) -> case foldM (flip applyResp) wallets resp of Right nextWallets -> App nextState errs nextWallets - Left err -> App lp (err : errs) wallets - Left err -> App lp (err : errs) wallets + Left err -> App lp ((act, lp, err) : errs) wallets + Left err -> App lp ((act, lp, err) : errs) wallets -- Configuration paprameters for app. data AppConfig = AppConfig @@ -83,7 +84,7 @@ defaultAppConfig = AppConfig reserves users curSym userNames = ["1", "2", "3"] coinNames = ["Dollar", "Euro", "Lira"] - reserves = fmap (\name -> CoinCfg (toCoin name) (R.fromInteger 1) (toAToken name)) coinNames + reserves = fmap (\name -> CoinCfg (toCoin name) (R.fromInteger 1) (toAToken name) defaultInterestModel) coinNames users = zipWith (\coinName userName -> (UserId (PubKeyHash userName), wal (toCoin coinName, 100))) coinNames userNames wal cs = BchWallet $ uncurry M.singleton cs diff --git a/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs b/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs new file mode 100644 index 000000000..a376430ca --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs @@ -0,0 +1,84 @@ +-- | Calculate interest rate parameters +module Mlabs.Lending.Logic.InterestRate( + updateReserveInterestRates + , getLiquidityRate + , getNormalisedIncome + , getCumulatedLiquidityIndex + , addDeposit + , getCumulativeBalance +) where + +import PlutusTx.Prelude +import qualified PlutusTx.Ratio as R + +import Mlabs.Lending.Logic.Types + +{-# INLINABLE updateReserveInterestRates #-} +updateReserveInterestRates :: Integer -> Reserve -> Reserve +updateReserveInterestRates currentTime reserve = reserve { reserve'interest = nextInterest reserve } + where + nextInterest Reserve{..} = reserve'interest + { ri'liquidityRate = liquidityRate + , ri'liquidityIndex = getCumulatedLiquidityIndex liquidityRate yearDelta $ ri'liquidityIndex reserve'interest + , ri'normalisedIncome = getNormalisedIncome liquidityRate yearDelta $ ri'liquidityIndex reserve'interest + , ri'lastUpdateTime = currentTime + } + where + yearDelta = getYearDelta lastUpdateTime currentTime + liquidityRate = getLiquidityRate reserve + lastUpdateTime = ri'lastUpdateTime reserve'interest + +{-# INLINABLE getYearDelta #-} +getYearDelta :: Integer -> Integer -> Rational +getYearDelta t0 t1 = R.fromInteger (max 0 $ t1 - t0) * secondsPerSlot * R.recip secondsPerYear + where + secondsPerSlot = R.fromInteger 1 + secondsPerYear = R.fromInteger 31622400 + +{-# INLINABLE getCumulatedLiquidityIndex #-} +getCumulatedLiquidityIndex :: Rational -> Rational -> Rational -> Rational +getCumulatedLiquidityIndex liquidityRate yearDelta prevLiquidityIndex = + (liquidityRate * yearDelta + R.fromInteger 1) * prevLiquidityIndex + +{-# INLINABLE getNormalisedIncome #-} +getNormalisedIncome :: Rational -> Rational -> Rational -> Rational +getNormalisedIncome liquidityRate yearDelta prevLiquidityIndex = + (liquidityRate * yearDelta + R.fromInteger 1) * prevLiquidityIndex + +{-# INLINABLE getLiquidityRate #-} +getLiquidityRate :: Reserve -> Rational +getLiquidityRate Reserve{..} = r * u + where + u = getUtilisation reserve'wallet + r = getBorrowRate (ri'interestModel reserve'interest) u + +{-# INLINABLE getUtilisation #-} +getUtilisation :: Wallet -> Rational +getUtilisation Wallet{..} = wallet'borrow % liquidity + where + liquidity = wallet'deposit + wallet'borrow + +{-# INLINABLE getBorrowRate #-} +getBorrowRate :: InterestModel -> Rational -> Rational +getBorrowRate InterestModel{..} u + | u <= uOptimal = im'base + im'slope1 * (u * R.recip uOptimal) + | otherwise = im'base + im'slope2 * (u - uOptimal) * R.recip (R.fromInteger 1 - uOptimal) + where + uOptimal = im'optimalUtilisation + +{-# INLINABLE addDeposit #-} +addDeposit :: Rational -> Integer -> Wallet -> Either String Wallet +addDeposit normalisedIncome amount wal + | newDeposit >= 0 = Right wal + { wallet'deposit = max 0 newDeposit + , wallet'scaledBalance = max (R.fromInteger 0) $ wallet'scaledBalance wal + R.fromInteger amount * R.recip normalisedIncome + } + | otherwise = Left "Negative deposit" + where + newDeposit = wallet'deposit wal + amount + +{-# INLINABLE getCumulativeBalance #-} +getCumulativeBalance :: Rational -> Wallet -> Rational +getCumulativeBalance normalisedIncome Wallet{..} = + wallet'scaledBalance * normalisedIncome + diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 972248e77..184d924fb 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -21,6 +21,7 @@ import Control.Monad.Except import Control.Monad.State.Strict import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.InterestRate (addDeposit) import Mlabs.Lending.Logic.State import Mlabs.Lending.Logic.Types @@ -28,8 +29,8 @@ import Mlabs.Lending.Logic.Types -- | State transitions for lending pool. -- For a given action we update internal state of Lending pool and produce -- list of responses to simulate change of the balances on blockchain. -react :: Act -> St [Resp] -react = \case +react :: Integer -> Act -> St [Resp] +react currentTime = \case UserAct uid act -> userAct uid act PriceAct act -> priceAct act GovernAct act -> governAct act @@ -37,8 +38,8 @@ react = \case -- | User acts userAct uid = \case DepositAct{..} -> depositAct uid act'amount act'asset - BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate - RepayAct{..} -> repayAct uid act'asset act'amount act'rate + BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate + RepayAct{..} -> repayAct uid act'asset act'amount act'rate SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion (R.fromInteger 1)) WithdrawAct{..} -> withdrawAct uid act'amount act'asset @@ -48,17 +49,16 @@ react = \case --------------------------------------------------- -- deposit - -- TODO: ignores ratio of liquidity to borrowed totals depositAct uid amount asset = do - modifyWalletAndReserve uid asset depositUser + ni <- getNormalisedIncome asset + modifyWalletAndReserve' uid asset (addDeposit ni amount) aCoin <- aToken asset + updateReserveState currentTime asset pure $ mconcat [ [Mint aCoin amount] , moveFromTo Self uid aCoin amount , moveFromTo uid Self asset amount ] - where - depositUser w@Wallet{..} = w { wallet'deposit = amount + wallet'deposit } --------------------------------------------------- -- borrow @@ -73,12 +73,13 @@ react = \case collateralNonBorrow uid asset hasEnoughCollateral uid asset amount updateOnBorrow + updateReserveState currentTime asset pure $ moveFromTo Self uid asset amount where - updateOnBorrow = modifyWalletAndReserve uid asset $ \w -> w - { wallet'deposit = wallet'deposit w - amount - , wallet'borrow = wallet'borrow w + amount - } + updateOnBorrow = do + ni <- getNormalisedIncome asset + modifyWallet uid asset $ \w -> w { wallet'borrow = wallet'borrow w + amount } + modifyReserveWallet' asset $ addDeposit ni (negate amount) hasEnoughLiquidityToBorrow asset amount = do liquidity <- getsReserve asset (wallet'deposit . reserve'wallet) @@ -100,13 +101,16 @@ react = \case -- repay (also called redeem in whitepaper) repayAct uid asset amount _rate = do + ni <- getNormalisedIncome asset bor <- getsWallet uid asset wallet'borrow let newBor = bor - amount if newBor >= 0 then modifyWallet uid asset $ \w -> w { wallet'borrow = newBor } - else modifyWallet uid asset $ \w -> w { wallet'borrow = 0 - , wallet'deposit = negate newBor } - modifyReserveWallet asset $ \w -> w { wallet'deposit = wallet'deposit w + amount } + else modifyWallet' uid asset $ \w -> do + w1 <- addDeposit ni (negate newBor) w + pure $ w1 { wallet'borrow = 0 } + modifyReserveWallet' asset $ addDeposit ni amount + updateReserveState currentTime asset pure $ moveFromTo uid Self asset amount --------------------------------------------------- @@ -122,25 +126,24 @@ react = \case | otherwise = setAsDeposit uid asset portion setAsCollateral uid asset portion - | portion <= R.fromInteger 0 = pure [] + | portion <= R.fromInteger 0 || portion > R.fromInteger 1 = pure [] | otherwise = do + ni <- getNormalisedIncome asset amount <- getAmountBy wallet'deposit uid asset portion - modifyWalletAndReserve uid asset $ \w -> w - { wallet'deposit = wallet'deposit w - amount - , wallet'collateral = wallet'collateral w + amount - } + modifyWalletAndReserve' uid asset $ \w -> do + w1 <- addDeposit ni (negate amount) w + pure $ w1 { wallet'collateral = wallet'collateral w + amount } aCoin <- aToken asset - pure $ mconcat - [ moveFromTo uid Self aCoin amount ] + pure $ moveFromTo uid Self aCoin amount setAsDeposit uid asset portion | portion <= R.fromInteger 0 = pure [] | otherwise = do amount <- getAmountBy wallet'collateral uid asset portion - modifyWalletAndReserve uid asset $ \w -> w - { wallet'deposit = wallet'deposit w + amount - , wallet'collateral = wallet'collateral w - amount - } + ni <- getNormalisedIncome asset + modifyWalletAndReserve' uid asset $ \w -> do + w1 <- addDeposit ni amount w + pure $ w1 { wallet'collateral = wallet'collateral w - amount } aCoin <- aToken asset pure $ moveFromTo Self uid aCoin amount @@ -155,8 +158,10 @@ react = \case -- validate withdraw hasEnoughDepositToWithdraw uid amount asset -- update state on withdraw - modifyWalletAndReserve uid asset $ \w -> w { wallet'deposit = wallet'deposit w - amount } + ni <- getNormalisedIncome asset + modifyWalletAndReserve' uid asset $ addDeposit ni (negate amount) aCoin <- aToken asset + updateReserveState currentTime asset pure $ mconcat [ moveFromTo Self uid asset amount , moveFromTo uid Self aCoin amount @@ -164,8 +169,8 @@ react = \case ] hasEnoughDepositToWithdraw uid amount asset = do - dep <- getsWallet uid asset wallet'deposit - guardError "Not enough deposit to withdraw" (dep >= amount) + dep <- getCumulativeBalance uid asset + guardError "Not enough deposit to withdraw" (dep >= R.fromInteger amount) --------------------------------------------------- -- flash loan diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 4aadedf9e..e5697892a 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -7,6 +7,7 @@ module Mlabs.Lending.Logic.State( , showt , Error , aToken + , updateReserveState , initReserve , guardError , getWallet, getsWallet @@ -29,6 +30,8 @@ module Mlabs.Lending.Logic.State( , modifyUser' , modifyWallet' , modifyWalletAndReserve' + , getNormalisedIncome + , getCumulativeBalance ) where import qualified PlutusTx.Ratio as R @@ -39,6 +42,7 @@ import qualified PlutusTx.AssocMap as M import Control.Monad.Except hiding (Functor(..), mapM) import Control.Monad.State.Strict hiding (Functor(..), mapM) +import qualified Mlabs.Lending.Logic.InterestRate as IR import Mlabs.Lending.Logic.Types -- | Type for errors @@ -63,6 +67,11 @@ instance Applicative St where ---------------------------------------------------- -- common functions +{-# INLINABLE updateReserveState #-} +updateReserveState :: Integer -> Coin -> St () +updateReserveState currentTime asset = + modifyReserve asset $ IR.updateReserveInterestRates currentTime + {-# INLINABLE aToken #-} aToken :: Coin -> St Coin aToken coin = do @@ -232,3 +241,14 @@ modifyWallet' uid coin f = modifyUser' uid $ \(User ws) -> do wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws pure $ User $ M.insert coin wal ws +{-# INLINABLE getNormalisedIncome #-} +getNormalisedIncome :: Coin -> St Rational +getNormalisedIncome asset = + getsReserve asset $ (ri'normalisedIncome . reserve'interest) + +{-# INLINABLE getCumulativeBalance #-} +getCumulativeBalance :: UserId -> Coin -> St Rational +getCumulativeBalance uid asset = do + ni <- getNormalisedIncome asset + getsWallet uid asset (IR.getCumulativeBalance ni) + diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index c1cf9678f..4fede0273 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -19,7 +19,10 @@ module Mlabs.Lending.Logic.Types( , defaultUser , UserId(..) , Reserve(..) + , ReserveInterest(..) , InterestRate(..) + , InterestModel(..) + , defaultInterestModel , CoinCfg(..) , initReserve , initLendingPool @@ -43,6 +46,7 @@ module Mlabs.Lending.Logic.Types( import Data.Aeson (FromJSON, ToJSON) +import qualified PlutusTx.Ratio as R import qualified Prelude as P import qualified PlutusTx as PlutusTx import PlutusTx.Prelude @@ -73,7 +77,7 @@ instance Eq UserId where data LendingPool = LendingPool { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app - , lp'currency :: !CurrencySymbol -- ^ main correncySymbol of the app + , lp'currency :: !CurrencySymbol -- ^ main currencySymbol of the app , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins } deriving (Show, Generic) @@ -84,17 +88,46 @@ data Reserve = Reserve { reserve'wallet :: !Wallet -- ^ total amounts of coins deposited to reserve , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin - , reserve'aToken :: !TokenName -- ^ aToken coressponding to the coin of the reserve + , reserve'aToken :: !TokenName -- ^ aToken corresponding to the coin of the reserve + , reserve'interest :: !ReserveInterest -- ^ reserve liquidity params } deriving (Show, Generic) +-- | Parameters for calculation of interest rates. +data ReserveInterest = ReserveInterest + { ri'interestModel :: !InterestModel + , ri'liquidityRate :: !Rational + , ri'liquidityIndex :: !Rational + , ri'normalisedIncome :: !Rational + , ri'lastUpdateTime :: !Integer + } + deriving (Show, Generic) + +data InterestModel = InterestModel + { im'optimalUtilisation :: !Rational + , im'slope1 :: !Rational + , im'slope2 :: !Rational + , im'base :: !Rational + } + deriving (Show, Generic, P.Eq) + deriving anyclass (FromJSON, ToJSON) + +defaultInterestModel :: InterestModel +defaultInterestModel = InterestModel + { im'base = R.fromInteger 0 + , im'slope1 = 1 % 5 + , im'slope2 = R.fromInteger 4 + , im'optimalUtilisation = 8 % 10 + } + -- | Coin configuration data CoinCfg = CoinCfg - { coinCfg'coin :: Coin - , coinCfg'rate :: Rational - , coinCfg'aToken :: TokenName + { coinCfg'coin :: Coin + , coinCfg'rate :: Rational + , coinCfg'aToken :: TokenName + , coinCfg'interestModel :: InterestModel } - deriving stock (Show, Generic) + deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) {-# INLINABLE initLendingPool #-} @@ -102,21 +135,31 @@ initLendingPool :: CurrencySymbol -> [CoinCfg] -> LendingPool initLendingPool curSym coinCfgs = LendingPool reserves M.empty curSym coinMap where reserves = M.fromList $ fmap (\cfg -> (coinCfg'coin cfg, initReserve cfg)) coinCfgs - coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken) -> (aToken, coin)) coinCfgs + coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken _) -> (aToken, coin)) coinCfgs {-# INLINABLE initReserve #-} -- | Initialise empty reserve with given ratio of its coin to ada initReserve :: CoinCfg -> Reserve initReserve CoinCfg{..} = Reserve { reserve'wallet = Wallet - { wallet'deposit = 0 - , wallet'borrow = 0 - , wallet'collateral = 0 + { wallet'deposit = 0 + , wallet'borrow = 0 + , wallet'collateral = 0 + , wallet'scaledBalance = R.fromInteger 0 } , reserve'rate = coinCfg'rate , reserve'liquidationThreshold = 8 % 10 , reserve'aToken = coinCfg'aToken + , reserve'interest = initInterest coinCfg'interestModel } + where + initInterest interestModel = ReserveInterest + { ri'interestModel = interestModel + , ri'liquidityRate = R.fromInteger 0 + , ri'liquidityIndex = R.fromInteger 1 + , ri'normalisedIncome = R.fromInteger 1 + , ri'lastUpdateTime = 0 + } -- | User is a set of wallets per currency data User = User @@ -136,19 +179,24 @@ data Wallet = Wallet { wallet'deposit :: !Integer -- ^ amount of deposit , wallet'collateral :: !Integer -- ^ amount of collateral , wallet'borrow :: !Integer -- ^ amount of borrow + , wallet'scaledBalance :: !Rational -- ^ scaled balance } deriving (Show, Generic) + {-# INLINABLE defaultWallet #-} defaultWallet :: Wallet -defaultWallet = Wallet 0 0 0 +defaultWallet = Wallet 0 0 0 (R.fromInteger 0) -- | Acts for lending platform data Act - = UserAct UserId UserAct -- ^ user's actions - | PriceAct PriceAct -- ^ price oracle's actions - | GovernAct GovernAct -- ^ app admin's actions - deriving stock (Show, Generic) + = UserAct + { userAct'userId :: UserId + , userAct'act :: UserAct + } -- ^ user's actions + | PriceAct PriceAct -- ^ price oracle's actions + | GovernAct GovernAct -- ^ app admin's actions + deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) -- | Lending pool action @@ -196,20 +244,20 @@ data UserAct , act'receiveAToken :: Bool } -- ^ call to liquidate borrows that are unsafe due to health check - deriving stock (Show, Generic) + deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) -- | Acts that can be done by admin users. data GovernAct = AddReserve CoinCfg -- ^ Adds new reserve - deriving stock (Show, Generic) + deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) -- | Updates for the prices of the currencies on the markets data PriceAct = SetAssetPrice Coin Rational -- ^ Set asset price | SetOracleAddr Coin UserId -- ^ Provide address of the oracle - deriving stock (Show, Generic) + deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) -- | Custom currency @@ -246,13 +294,16 @@ data PriceOracleProvider = PriceOracleProvider data InterestRateStrategy = InterestRateStrategy data InterestRate = StableRate | VariableRate - deriving stock (Show, Generic) + deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) ------------------------------------------- +--------------------------------------------------------------- +-- boilerplate instances PlutusTx.unstableMakeIsData ''CoinCfg +PlutusTx.unstableMakeIsData ''InterestModel PlutusTx.unstableMakeIsData ''InterestRate +PlutusTx.unstableMakeIsData ''ReserveInterest PlutusTx.unstableMakeIsData ''UserAct PlutusTx.unstableMakeIsData ''PriceAct PlutusTx.unstableMakeIsData ''GovernAct diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 00816730c..9f19aaa55 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -11,7 +11,7 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified PlutusTx.Ratio as R -import Mlabs.Lending.Logic.Types (UserAct(..), InterestRate(..), CoinCfg(..)) +import Mlabs.Lending.Logic.Types (UserAct(..), InterestRate(..), CoinCfg(..), defaultInterestModel) import qualified Mlabs.Lending.Contract.Lendex as L import Test.Utils @@ -45,7 +45,14 @@ test = testGroup "Contract" depositScript :: Trace.EmulatorTrace () depositScript = do L.callStartLendex wAdmin $ L.StartParams - { sp'coins = fmap (\(coin, aCoin) -> CoinCfg coin (R.fromInteger 1) aCoin) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] } + { sp'coins = fmap (\(coin, aCoin) -> CoinCfg + { coinCfg'coin = coin + , coinCfg'rate = R.fromInteger 1 + , coinCfg'aToken = aCoin + , coinCfg'interestModel = defaultInterestModel + }) + [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] + } wait 5 userAct1 $ DepositAct 50 coin1 next diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 7d4ce3737..0ed83d233 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -14,11 +14,25 @@ import Mlabs.Lending.Logic.App import Mlabs.Lending.Logic.Emulator import Mlabs.Lending.Logic.Types +import Text.Show.Pretty + import qualified Data.Map.Strict as M import qualified PlutusTx.Ratio as R -noErrors :: App -> Bool -noErrors app = null $ app'log app +noErrors :: App -> Assertion +noErrors app = case app'log app of + [] -> assertBool "no errors" True + xs -> do + mapM_ printLog xs + assertFailure "There are errors" + where + printLog (act, lp, msg) = do + pPrint act + pPrint lp + print msg + +someErrors :: App -> Assertion +someErrors app = assertBool "Script fails" $ not $ null (app'log app) -- | Test suite for a logic of lending application test :: TestTree @@ -39,8 +53,8 @@ test = testGroup "Logic" where wal coin aToken = BchWallet $ M.fromList [(coin, 50), (fromToken aToken, 50)] - testBorrowNoCollateral = testScript borrowNoCollateralScript @=? False - testBorrowNotEnoughCollateral = testScript borrowNotEnoughCollateralScript @=? False + testBorrowNoCollateral = someErrors $ testScript borrowNoCollateralScript + testBorrowNotEnoughCollateral = someErrors $ testScript borrowNotEnoughCollateralScript testWithdraw = testWallets [(user1, w1)] withdrawScript where @@ -61,13 +75,13 @@ test = testGroup "Logic" w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 10), (fromToken aToken1, 0)] -- | Checks that script runs without errors -testScript :: [Act] -> Bool -testScript script = noErrors $ runApp testAppConfig script +testScript :: [Act] -> App +testScript script = runApp testAppConfig script -- | Check that we have those wallets after script was run. testWallets :: [(UserId, BchWallet)] -> [Act] -> Assertion testWallets wals script = do - assertBool "Script has no errors" $ noErrors app + noErrors app mapM_ (uncurry $ hasWallet app) wals where app = runApp testAppConfig script @@ -188,7 +202,12 @@ aToken3 = tokenName "aLira" testAppConfig :: AppConfig testAppConfig = AppConfig reserves users lendingPoolCurrency where - reserves = fmap (\(coin, aCoin) -> CoinCfg coin (R.fromInteger 1) aCoin) + reserves = fmap (\(coin, aCoin) -> CoinCfg + { coinCfg'coin = coin + , coinCfg'rate = R.fromInteger 1 + , coinCfg'aToken = aCoin + , coinCfg'interestModel = defaultInterestModel + }) [(coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] users = From 8092c860ecdaecd91ed82f5e47408d83ae209923 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 16:23:16 +0300 Subject: [PATCH 28/81] Improves and fixes tests --- mlabs/mlabs-plutus-use-cases.cabal | 7 +- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 7 +- mlabs/src/Mlabs/Lending/Logic/App.hs | 95 ---------------------- mlabs/src/Mlabs/Lending/Logic/Emulator.hs | 79 ------------------ mlabs/src/Mlabs/Lending/Logic/React.hs | 30 +++---- mlabs/src/Mlabs/Lending/Logic/Types.hs | 3 +- mlabs/test/Test/Lending/Init.hs | 3 +- mlabs/test/Test/Lending/Logic.hs | 82 ++++++++----------- 8 files changed, 60 insertions(+), 246 deletions(-) delete mode 100644 mlabs/src/Mlabs/Lending/Logic/App.hs delete mode 100644 mlabs/src/Mlabs/Lending/Logic/Emulator.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 903406b69..a8ce49b9d 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -43,13 +43,13 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: --- Mlabs.Lending Mlabs.Lending.Contract.Coin Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex Mlabs.Lending.Contract.Utils - Mlabs.Lending.Logic.App - Mlabs.Lending.Logic.Emulator + Mlabs.Lending.Logic.Emulator.App + Mlabs.Lending.Logic.Emulator.Blockchain + Mlabs.Lending.Logic.Emulator.Script Mlabs.Lending.Logic.InterestRate Mlabs.Lending.Logic.React Mlabs.Lending.Logic.State @@ -129,7 +129,6 @@ Test-suite mlabs-plutus-use-cases-tests hs-source-dirs: test Main-is: Main.hs Other-modules: - -- Test.Lending Test.Lending.Contract Test.Lending.Init Test.Lending.Logic diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index c692c1817..c41e29a8e 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -43,7 +43,7 @@ import PlutusTx.Prelude hiding (Applicative (..), check, S import qualified PlutusTx.Prelude as PlutusTx -import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.Emulator.Blockchain import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types import qualified Mlabs.Lending.Contract.Forge as Forge @@ -89,7 +89,7 @@ transition :: SM.State LendingPool -> Act -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) -transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react 0 input) oldData of +transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of Left _err -> Nothing Right (resps, newData) -> Just ( foldMap toConstraints resps , SM.State { stateData=newData @@ -115,12 +115,13 @@ findInputStateDatum = do userAction :: UserAct -> UserApp () userAction act = do + currentTimestamp <- getSlot <$> currentSlot pkh <- fmap pubKeyHash ownPubKey inputDatum <- findInputStateDatum let lookups = monetaryPolicy Forge.currencyPolicy P.<> ownPubKeyHash pkh constraints = mustIncludeDatum inputDatum - t <- SM.mkStep client (UserAct (UserId pkh) act) + t <- SM.mkStep client (UserAct currentTimestamp (UserId pkh) act) logInfo @String $ "Executes action " P.<> show act case t of Left _err -> logError ("Action failed" :: String) diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs deleted file mode 100644 index a9d6a72c4..000000000 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ /dev/null @@ -1,95 +0,0 @@ --- | Lending app emulator -module Mlabs.Lending.Logic.App( - App(..) - , runApp - , AppConfig(..) - , defaultAppConfig - , lookupAppWallet - , toCoin -) where - -import PlutusTx.Prelude -import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) -import Plutus.V1.Ledger.Value - -import Control.Monad.State.Strict hiding (Functor(..)) - -import Data.List (foldl') - -import Mlabs.Lending.Logic.Emulator -import Mlabs.Lending.Logic.React -import Mlabs.Lending.Logic.Types -import Mlabs.Lending.Logic.State - -import qualified Data.Map.Strict as M -import qualified PlutusTx.AssocMap as AM -import qualified PlutusTx.Ratio as R - --- | Prototype application -data App = App - { app'pool :: !LendingPool -- ^ lending pool - , app'log :: ![(Act, LendingPool, Error)] -- ^ error log - -- ^ it reports on which act and pool state error has happened - , app'wallets :: !BchState -- ^ current state of blockchain - } - --- | Lookup state of the blockchain-wallet for a given user-id. -lookupAppWallet :: UserId -> App -> Maybe BchWallet -lookupAppWallet uid App{..} = case app'wallets of - BchState wals -> M.lookup uid wals - --- | Runs application with the list of actions. --- Returns final state of the application. -runApp :: AppConfig -> [Act] -> App -runApp cfg acts = foldl' go (initApp cfg) $ zip [0..] acts - where - -- There are two possible sources of errors: - -- * we can not make transition to state (react produces Left) - -- * the transition produces action on blockchain that leads to negative balances (applyResp produces Left) - go (App lp errs wallets) (timestamp, act) = case runStateT (react timestamp act) lp of - Right (resp, nextState) -> case foldM (flip applyResp) wallets resp of - Right nextWallets -> App nextState errs nextWallets - Left err -> App lp ((act, lp, err) : errs) wallets - Left err -> App lp ((act, lp, err) : errs) wallets - --- Configuration paprameters for app. -data AppConfig = AppConfig - { appConfig'reserves :: [CoinCfg] - -- ^ coins with ratios to base currencies for each reserve - , appConfig'users :: [(UserId, BchWallet)] - -- ^ initial set of users with their wallets on blockchain - -- the wallet for lending app wil be created automatically. - -- no need to include it here - , appConfig'currencySymbol :: CurrencySymbol - -- ^ lending app main currency symbol - } - --- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) -initApp :: AppConfig -> App -initApp AppConfig{..} = App - { app'pool = LendingPool (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) AM.empty appConfig'currencySymbol coinMap - , app'log = [] - , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users - } - where - coinMap = AM.fromList $ fmap (\CoinCfg{..} -> (coinCfg'aToken, coinCfg'coin)) $ appConfig'reserves - --- | Default application. --- It allocates three users nad three reserves for Dollars, Euros and Liras. --- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. -defaultAppConfig :: AppConfig -defaultAppConfig = AppConfig reserves users curSym - where - curSym = currencySymbol "lending-app" - userNames = ["1", "2", "3"] - coinNames = ["Dollar", "Euro", "Lira"] - - reserves = fmap (\name -> CoinCfg (toCoin name) (R.fromInteger 1) (toAToken name) defaultInterestModel) coinNames - - users = zipWith (\coinName userName -> (UserId (PubKeyHash userName), wal (toCoin coinName, 100))) coinNames userNames - wal cs = BchWallet $ uncurry M.singleton cs - - toAToken name = tokenName $ "a" <> name - -toCoin :: ByteString -> Coin -toCoin str = AssetClass (currencySymbol str, tokenName str) diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator.hs deleted file mode 100644 index 8204ecefc..000000000 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator.hs +++ /dev/null @@ -1,79 +0,0 @@ --- | Simple emulation ob blockchain state -module Mlabs.Lending.Logic.Emulator( - BchState(..) - , BchWallet(..) - , defaultBchWallet - , Resp(..) - , applyResp - , moveFromTo -) where - -import qualified Prelude as P -import PlutusTx.Prelude hiding (fromMaybe, maybe) - -import Data.Maybe -import Data.Map.Strict (Map) -import Mlabs.Lending.Logic.Types - -import qualified Data.Map.Strict as M - --- | Blockchain state is a set of wallets -newtype BchState = BchState (Map UserId BchWallet) - --- " For simplicity wallet is a map of coins to balances. -newtype BchWallet = BchWallet (Map Coin Integer) - deriving newtype (Show, P.Eq) - -instance Eq BchWallet where - (BchWallet a) == (BchWallet b) = M.toList a == M.toList b - --- | Default empty wallet -defaultBchWallet :: BchWallet -defaultBchWallet = BchWallet M.empty - --- | We can give money to vallets and take it from them. --- We can mint new aToken coins on lending platform and burn it. -data Resp - = Move - { move'addr :: UserId -- where move happens - , move'coin :: Coin -- on which value - , move'amount :: Integer -- how many to add (can be negative) - } - -- ^ move coins on wallet - | Mint - { mint'coin :: Coin - , mint'amount :: Integer - } - -- ^ mint new coins for lending platform - | Burn - { mint'coin :: Coin - , mint'amount :: Integer - } - -- ^ burns coins for lending platform - deriving (Show) - --- | Moves from first user to second user -moveFromTo :: UserId -> UserId -> Coin -> Integer -> [Resp] -moveFromTo from to coin amount = - [ Move from coin (negate amount) - , Move to coin amount - ] - --- | Applies reponse to the blockchain state. -applyResp :: Resp -> BchState -> Either String BchState -applyResp resp (BchState wallets) = fmap BchState $ case resp of - Move addr coin amount -> updateWallet addr coin amount wallets - Mint coin amount -> updateWallet Self coin amount wallets - Burn coin amount -> updateWallet Self coin (negate amount) wallets - where - updateWallet addr coin amt m = M.alterF (maybe (pure Nothing) (fmap Just . updateBalance coin amt)) addr m - - updateBalance :: Coin -> Integer -> BchWallet -> Either String BchWallet - updateBalance coin amt (BchWallet bals) = fmap BchWallet $ M.alterF (upd amt) coin bals - - upd amt x - | res >= 0 = Right $ Just res - | otherwise = Left $ "Negative balance" - where - res = fromMaybe 0 x + amt - diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 184d924fb..5e0470600 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -20,7 +20,7 @@ import qualified PlutusTx.AssocMap as M import Control.Monad.Except import Control.Monad.State.Strict -import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.Emulator.Blockchain import Mlabs.Lending.Logic.InterestRate (addDeposit) import Mlabs.Lending.Logic.State import Mlabs.Lending.Logic.Types @@ -29,27 +29,27 @@ import Mlabs.Lending.Logic.Types -- | State transitions for lending pool. -- For a given action we update internal state of Lending pool and produce -- list of responses to simulate change of the balances on blockchain. -react :: Integer -> Act -> St [Resp] -react currentTime = \case - UserAct uid act -> userAct uid act - PriceAct act -> priceAct act - GovernAct act -> governAct act +react :: Act -> St [Resp] +react = \case + UserAct t uid act -> userAct t uid act + PriceAct act -> priceAct act + GovernAct act -> governAct act where -- | User acts - userAct uid = \case - DepositAct{..} -> depositAct uid act'amount act'asset - BorrowAct{..} -> borrowAct uid act'asset act'amount act'rate - RepayAct{..} -> repayAct uid act'asset act'amount act'rate + userAct time uid = \case + DepositAct{..} -> depositAct time uid act'amount act'asset + BorrowAct{..} -> borrowAct time uid act'asset act'amount act'rate + RepayAct{..} -> repayAct time uid act'asset act'amount act'rate SwapBorrowRateModelAct{..} -> swapBorrowRateModelAct uid act'asset act'rate SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion (R.fromInteger 1)) - WithdrawAct{..} -> withdrawAct uid act'amount act'asset + WithdrawAct{..} -> withdrawAct time uid act'amount act'asset FlashLoanAct -> flashLoanAct uid LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken --------------------------------------------------- -- deposit - depositAct uid amount asset = do + depositAct currentTime uid amount asset = do ni <- getNormalisedIncome asset modifyWalletAndReserve' uid asset (addDeposit ni amount) aCoin <- aToken asset @@ -68,7 +68,7 @@ react currentTime = \case -- * reserve has enough liquidity -- * user does not use collateral reserve to borrow (it's meaningless for the user) -- * user has enough collateral for the borrow - borrowAct uid asset amount _rate = do + borrowAct currentTime uid asset amount _rate = do hasEnoughLiquidityToBorrow asset amount collateralNonBorrow uid asset hasEnoughCollateral uid asset amount @@ -100,7 +100,7 @@ react currentTime = \case --------------------------------------------------- -- repay (also called redeem in whitepaper) - repayAct uid asset amount _rate = do + repayAct currentTime uid asset amount _rate = do ni <- getNormalisedIncome asset bor <- getsWallet uid asset wallet'borrow let newBor = bor - amount @@ -154,7 +154,7 @@ react currentTime = \case --------------------------------------------------- -- withdraw - withdrawAct uid amount asset = do + withdrawAct currentTime uid amount asset = do -- validate withdraw hasEnoughDepositToWithdraw uid amount asset -- update state on withdraw diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 4fede0273..ecd61207a 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -191,7 +191,8 @@ defaultWallet = Wallet 0 0 0 (R.fromInteger 0) -- | Acts for lending platform data Act = UserAct - { userAct'userId :: UserId + { userAct'time :: Integer + , userAct'userId :: UserId , userAct'act :: UserAct } -- ^ user's actions | PriceAct PriceAct -- ^ price oracle's actions diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index dc3a08ac0..f704baeca 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -11,7 +11,6 @@ module Test.Lending.Init( import Prelude --- import Data.Default import Control.Lens import Plutus.V1.Ledger.Value (Value, TokenName) @@ -23,7 +22,7 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import Mlabs.Lending.Logic.Types (Coin, UserAct(..)) -import qualified Mlabs.Lending.Logic.App as L +import qualified Mlabs.Lending.Logic.Emulator.App as L import qualified Mlabs.Lending.Contract.Lendex as L import qualified Mlabs.Lending.Contract.Forge as Forge diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 0ed83d233..5d002c26d 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -10,8 +10,8 @@ import Test.Tasty.HUnit import Plutus.V1.Ledger.Value import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) -import Mlabs.Lending.Logic.App -import Mlabs.Lending.Logic.Emulator +import Mlabs.Lending.Logic.Emulator.App +import Mlabs.Lending.Logic.Emulator.Blockchain import Mlabs.Lending.Logic.Types import Text.Show.Pretty @@ -75,11 +75,11 @@ test = testGroup "Logic" w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 10), (fromToken aToken1, 0)] -- | Checks that script runs without errors -testScript :: [Act] -> App +testScript :: Script -> App testScript script = runApp testAppConfig script -- | Check that we have those wallets after script was run. -testWallets :: [(UserId, BchWallet)] -> [Act] -> Assertion +testWallets :: [(UserId, BchWallet)] -> Script -> Assertion testWallets wals script = do noErrors app mapM_ (uncurry $ hasWallet app) wals @@ -91,81 +91,69 @@ hasWallet :: App -> UserId -> BchWallet -> Assertion hasWallet app uid wal = lookupAppWallet uid app @=? Just wal -- | 3 users deposit 50 coins to lending app -depositScript :: [Act] -depositScript = - [ UserAct user1 $ DepositAct 50 coin1 - , UserAct user2 $ DepositAct 50 coin2 - , UserAct user3 $ DepositAct 50 coin3 - ] +depositScript :: Script +depositScript = do + userAct user1 $ DepositAct 50 coin1 + userAct user2 $ DepositAct 50 coin2 + userAct user3 $ DepositAct 50 coin3 -- | 3 users deposit 50 coins to lending app -- and first user borrows in coin2 that he does not own prior to script run. -borrowScript :: [Act] -borrowScript = mconcat - [ depositScript - , [ UserAct user1 $ SetUserReserveAsCollateralAct +borrowScript :: Script +borrowScript = do + depositScript + userAct user1 $ SetUserReserveAsCollateralAct { act'asset = coin1 , act'useAsCollateral = True - , act'portion = R.fromInteger 1 - } - , UserAct user1 $ BorrowAct + , act'portion = R.fromInteger 1 } + userAct user1 $ BorrowAct { act'asset = coin2 , act'amount = 30 - , act'rate = StableRate - } - ] - ] + , act'rate = StableRate } -- | Try to borrow without setting up deposit as collateral. -borrowNoCollateralScript :: [Act] -borrowNoCollateralScript = mconcat - [ depositScript - , pure $ UserAct user1 $ BorrowAct +borrowNoCollateralScript :: Script +borrowNoCollateralScript = do + depositScript + userAct user1 $ BorrowAct { act'asset = coin2 , act'amount = 30 , act'rate = StableRate } - ] -- | Try to borrow more than collateral permits -borrowNotEnoughCollateralScript :: [Act] -borrowNotEnoughCollateralScript = mconcat - [ depositScript - , [ UserAct user1 $ SetUserReserveAsCollateralAct +borrowNotEnoughCollateralScript :: Script +borrowNotEnoughCollateralScript = do + depositScript + userAct user1 $ SetUserReserveAsCollateralAct { act'asset = coin1 , act'useAsCollateral = True - , act'portion = R.fromInteger 1 - } - , UserAct user1 $ BorrowAct + , act'portion = R.fromInteger 1 } + userAct user1 $ BorrowAct { act'asset = coin2 , act'amount = 60 - , act'rate = StableRate - } - ] - ] + , act'rate = StableRate } -- | User1 deposits 50 out of 100 and gets back 25. -- So we check that user has 75 coins and 25 aCoins -withdrawScript :: [Act] -withdrawScript = mconcat - [ depositScript - , pure $ UserAct user1 $ WithdrawAct +withdrawScript :: Script +withdrawScript = do + depositScript + userAct user1 $ WithdrawAct { act'amount = 25 , act'asset = coin1 } - ] -- | We use borrow script to deposit and borrow for user 1 -- and then repay part of the borrow. -repayScript :: [Act] -repayScript = mconcat - [ borrowScript - , pure $ UserAct user1 $ RepayAct +repayScript :: Script +repayScript = do + borrowScript + userAct user1 $ RepayAct { act'asset = coin2 , act'amount = 20 , act'rate = StableRate } - ] --------------------------------- -- constants From 593f3bb88d493928f52bf6bc2fc14247092cd952 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 16:23:47 +0300 Subject: [PATCH 29/81] A bit of refactoring --- mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs | 98 +++++++++++++++++++ .../Lending/Logic/Emulator/Blockchain.hs | 79 +++++++++++++++ .../Mlabs/Lending/Logic/Emulator/Script.hs | 63 ++++++++++++ 3 files changed, 240 insertions(+) create mode 100644 mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs create mode 100644 mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs create mode 100644 mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs new file mode 100644 index 000000000..899c2ab6b --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs @@ -0,0 +1,98 @@ +-- | Lending app emulator +module Mlabs.Lending.Logic.Emulator.App( + App(..) + , runApp + , AppConfig(..) + , defaultAppConfig + , lookupAppWallet + , toCoin + , module X +) where + +import PlutusTx.Prelude +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) +import Plutus.V1.Ledger.Value + +import Control.Monad.State.Strict hiding (Functor(..)) + +import Data.List (foldl') + +import Mlabs.Lending.Logic.Emulator.Blockchain +import Mlabs.Lending.Logic.Emulator.Script as X +import Mlabs.Lending.Logic.React +import Mlabs.Lending.Logic.Types +import Mlabs.Lending.Logic.State + +import qualified Data.Map.Strict as M +import qualified PlutusTx.AssocMap as AM +import qualified PlutusTx.Ratio as R + +-- | Prototype application +data App = App + { app'pool :: !LendingPool -- ^ lending pool + , app'log :: ![(Act, LendingPool, Error)] -- ^ error log + -- ^ it reports on which act and pool state error has happened + , app'wallets :: !BchState -- ^ current state of blockchain + } + +-- | Lookup state of the blockchain-wallet for a given user-id. +lookupAppWallet :: UserId -> App -> Maybe BchWallet +lookupAppWallet uid App{..} = case app'wallets of + BchState wals -> M.lookup uid wals + +-- | Runs application with the list of actions. +-- Returns final state of the application. +runApp :: AppConfig -> Script -> App +runApp cfg acts = foldl' go (initApp cfg) $ runScript acts + where + -- There are two possible sources of errors: + -- * we can not make transition to state (react produces Left) + -- * the transition produces action on blockchain that leads to negative balances (applyResp produces Left) + go (App lp errs wallets) act = case runStateT (react act) lp of + Right (resp, nextState) -> case foldM (flip applyResp) wallets resp of + Right nextWallets -> App nextState errs nextWallets + Left err -> App lp ((act, lp, err) : errs) wallets + Left err -> App lp ((act, lp, err) : errs) wallets + +-- Configuration paprameters for app. +data AppConfig = AppConfig + { appConfig'reserves :: [CoinCfg] + -- ^ coins with ratios to base currencies for each reserve + , appConfig'users :: [(UserId, BchWallet)] + -- ^ initial set of users with their wallets on blockchain + -- the wallet for lending app wil be created automatically. + -- no need to include it here + , appConfig'currencySymbol :: CurrencySymbol + -- ^ lending app main currency symbol + } + +-- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) +initApp :: AppConfig -> App +initApp AppConfig{..} = App + { app'pool = LendingPool (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) AM.empty appConfig'currencySymbol coinMap + , app'log = [] + , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users + } + where + coinMap = AM.fromList $ fmap (\CoinCfg{..} -> (coinCfg'aToken, coinCfg'coin)) $ appConfig'reserves + +-- | Default application. +-- It allocates three users nad three reserves for Dollars, Euros and Liras. +-- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. +defaultAppConfig :: AppConfig +defaultAppConfig = AppConfig reserves users curSym + where + curSym = currencySymbol "lending-app" + userNames = ["1", "2", "3"] + coinNames = ["Dollar", "Euro", "Lira"] + + reserves = fmap (\name -> CoinCfg (toCoin name) (R.fromInteger 1) (toAToken name) defaultInterestModel) coinNames + + users = zipWith (\coinName userName -> (UserId (PubKeyHash userName), wal (toCoin coinName, 100))) coinNames userNames + wal cs = BchWallet $ uncurry M.singleton cs + + toAToken name = tokenName $ "a" <> name + +toCoin :: ByteString -> Coin +toCoin str = AssetClass (currencySymbol str, tokenName str) + diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs new file mode 100644 index 000000000..1f3d52bda --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs @@ -0,0 +1,79 @@ +-- | Simple emulation ob blockchain state +module Mlabs.Lending.Logic.Emulator.Blockchain( + BchState(..) + , BchWallet(..) + , defaultBchWallet + , Resp(..) + , applyResp + , moveFromTo +) where + +import qualified Prelude as P +import PlutusTx.Prelude hiding (fromMaybe, maybe) + +import Data.Maybe +import Data.Map.Strict (Map) +import Mlabs.Lending.Logic.Types + +import qualified Data.Map.Strict as M + +-- | Blockchain state is a set of wallets +newtype BchState = BchState (Map UserId BchWallet) + +-- " For simplicity wallet is a map of coins to balances. +newtype BchWallet = BchWallet (Map Coin Integer) + deriving newtype (Show, P.Eq) + +instance Eq BchWallet where + (BchWallet a) == (BchWallet b) = M.toList a == M.toList b + +-- | Default empty wallet +defaultBchWallet :: BchWallet +defaultBchWallet = BchWallet M.empty + +-- | We can give money to vallets and take it from them. +-- We can mint new aToken coins on lending platform and burn it. +data Resp + = Move + { move'addr :: UserId -- where move happens + , move'coin :: Coin -- on which value + , move'amount :: Integer -- how many to add (can be negative) + } + -- ^ move coins on wallet + | Mint + { mint'coin :: Coin + , mint'amount :: Integer + } + -- ^ mint new coins for lending platform + | Burn + { mint'coin :: Coin + , mint'amount :: Integer + } + -- ^ burns coins for lending platform + deriving (Show) + +-- | Moves from first user to second user +moveFromTo :: UserId -> UserId -> Coin -> Integer -> [Resp] +moveFromTo from to coin amount = + [ Move from coin (negate amount) + , Move to coin amount + ] + +-- | Applies reponse to the blockchain state. +applyResp :: Resp -> BchState -> Either String BchState +applyResp resp (BchState wallets) = fmap BchState $ case resp of + Move addr coin amount -> updateWallet addr coin amount wallets + Mint coin amount -> updateWallet Self coin amount wallets + Burn coin amount -> updateWallet Self coin (negate amount) wallets + where + updateWallet addr coin amt m = M.alterF (maybe (pure Nothing) (fmap Just . updateBalance coin amt)) addr m + + updateBalance :: Coin -> Integer -> BchWallet -> Either String BchWallet + updateBalance coin amt (BchWallet bals) = fmap BchWallet $ M.alterF (upd amt) coin bals + + upd amt x + | res >= 0 = Right $ Just res + | otherwise = Left $ "Negative balance" + where + res = fromMaybe 0 x + amt + diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs new file mode 100644 index 000000000..9489a1768 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs @@ -0,0 +1,63 @@ +-- | Helper for testing logic of lending pool +module Mlabs.Lending.Logic.Emulator.Script( + Script + , runScript + , userAct + , priceAct + , governAct +) where + +import Prelude (Semigroup(..), Monoid(..), Applicative(..)) + +import Control.Monad.State.Strict + +import Data.Foldable +import Data.Sequence (Seq) +import Data.Monoid (Sum(..)) +import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..), Functor, Applicative, toList) + +import Mlabs.Lending.Logic.Types +import qualified Data.Sequence as Seq + +-- | Collects user actions and allocates timestamps +type Script = ScriptM () + +-- | Auto-allocation of timestamps, monadic interface for collection of actions +newtype ScriptM a = Script (State St a) + deriving newtype (Functor, Applicative, Monad, MonadState St) + +-- | Script accumulator state. +data St = St + { st'acts :: Seq Act -- ^ acts so far + , st'time :: Sum Integer -- ^ current timestamp + } + +instance Semigroup St where + St a1 t1 <> St a2 t2 = St (a1 <> a2) (t1 <> t2) + +instance Monoid St where + mempty = St mempty mempty + +-- | Extract list of acts from the script +runScript :: Script -> [Act] +runScript (Script actions) = + toList $ st'acts $ execState actions (St Seq.empty 0) + +-- | Make user act +userAct :: UserId -> UserAct -> Script +userAct uid act = do + time <- gets (getSum . st'time) + putAct $ UserAct time uid act + +-- | Make price act +priceAct :: PriceAct -> Script +priceAct arg = putAct $ PriceAct arg + +-- | Make govern act +governAct :: GovernAct -> Script +governAct arg = putAct $ GovernAct arg + +putAct :: Act -> Script +putAct act = + modify' (<> St (Seq.singleton act) (Sum 1)) + From f56290f69b6ff215f4b3fdf7fb2e12a2cceeeb5e Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 16:29:57 +0300 Subject: [PATCH 30/81] Implement validation check for timestamps --- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index c41e29a8e..a81b66bca 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -61,9 +61,21 @@ type Lendex = SM.StateMachine LendingPool Act {-# INLINABLE machine #-} machine :: Lendex machine = (SM.mkStateMachine Nothing transition isFinal) + { SM.smCheck = checkTimestamp } where isFinal = const False + checkTimestamp _ input ctx = maybe True check $ getInputTime input + where + check t = member (Slot t) range + range = txInfoValidRange $ scriptContextTxInfo ctx + + + getInputTime = \case + UserAct time _ _ -> Just time + _ -> Nothing + + {-# INLINABLE mkValidator #-} mkValidator :: Scripts.ValidatorType Lendex mkValidator = SM.mkValidator machine From b16b446ad2c96d77ce876f5a21e90ae42c0ce582 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 17:18:18 +0300 Subject: [PATCH 31/81] Check weather input is valid --- mlabs/src/Mlabs/Lending/Logic/React.hs | 59 ++++++++++++++++++++++++-- mlabs/src/Mlabs/Lending/Logic/State.hs | 36 ++++++++++++++++ mlabs/test/Test/Lending/Init.hs | 1 - 3 files changed, 91 insertions(+), 5 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 5e0470600..836ca41a9 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -30,10 +30,12 @@ import Mlabs.Lending.Logic.Types -- For a given action we update internal state of Lending pool and produce -- list of responses to simulate change of the balances on blockchain. react :: Act -> St [Resp] -react = \case - UserAct t uid act -> userAct t uid act - PriceAct act -> priceAct act - GovernAct act -> governAct act +react input = do + checkInput input + case input of + UserAct t uid act -> userAct t uid act + PriceAct act -> priceAct act + GovernAct act -> governAct act where -- | User acts userAct time uid = \case @@ -217,4 +219,53 @@ react = \case todo = return [] +{-# INLINABLE checkInput #-} +-- | Check if input is valid +checkInput :: Act -> St () +checkInput = \case + UserAct time _uid act -> do + isNonNegative "timestamp" time + checkUserAct act + PriceAct act -> checkPriceAct act + GovernAct act -> checkGovernAct act + where + checkUserAct = \case + DepositAct amount asset -> do + isPositive "deposit" amount + isAsset asset + BorrowAct asset amount _rate -> do + isPositive "borrow" amount + isAsset asset + RepayAct asset amount _rate -> do + isPositive "repay" amount + isAsset asset + SwapBorrowRateModelAct asset _rate -> isAsset asset + SetUserReserveAsCollateralAct asset _useAsCollateral portion -> do + isAsset asset + isUnitRange "deposit portion" portion + WithdrawAct amount asset -> do + isPositive "withdraw" amount + isAsset asset + FlashLoanAct -> pure () + LiquidationCallAct _collateral _debt _user debtToCover _receiveAToken -> + isPositive "Debt to cover" debtToCover + + checkPriceAct = \case + SetAssetPrice asset price -> do + isPositiveRational "price" price + isAsset asset + SetOracleAddr asset _uid -> + isAsset asset + + checkGovernAct = \case + AddReserve cfg -> checkCoinCfg cfg + + checkCoinCfg CoinCfg{..} = do + isPositiveRational "coin price" coinCfg'rate + checkInterestModel coinCfg'interestModel + + checkInterestModel InterestModel{..} = do + isUnitRange "optimal utilisation" im'optimalUtilisation + isPositiveRational "slope 1" im'slope1 + isPositiveRational "slope 2" im'slope2 diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index e5697892a..0018a3360 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -6,6 +6,11 @@ module Mlabs.Lending.Logic.State( St , showt , Error + , isNonNegative + , isPositive + , isPositiveRational + , isUnitRange + , isAsset , aToken , updateReserveState , initReserve @@ -66,6 +71,37 @@ instance Applicative St where ---------------------------------------------------- -- common functions +{-# INLINABLE isNonNegative #-} +isNonNegative :: String -> Integer -> St () +isNonNegative msg val + | val >= 0 = pure () + | otherwise = throwError $ msg <> " should be non-negative" + +{-# INLINABLE isPositive #-} +isPositive :: String -> Integer -> St () +isPositive msg val + | val > 0 = pure () + | otherwise = throwError $ msg <> " should be positive" + +{-# INLINABLE isPositiveRational #-} +isPositiveRational :: String -> Rational -> St () +isPositiveRational msg val + | val > R.fromInteger 0 = pure () + | otherwise = throwError $ msg <> " should be positive" + +{-# INLINABLE isUnitRange #-} +isUnitRange :: String -> Rational -> St () +isUnitRange msg val + | val >= R.fromInteger 0 && val <= R.fromInteger 1 = pure () + | otherwise = throwError $ msg <> " should have unit range [0, 1]" + +{-# INLINABLE isAsset #-} +isAsset :: Coin -> St () +isAsset asset = do + reserves <- gets lp'reserves + if M.member asset reserves + then pure () + else throwError "Asset not supported" {-# INLINABLE updateReserveState #-} updateReserveState :: Integer -> Coin -> St () diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index f704baeca..bd9296fb0 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -84,4 +84,3 @@ initialDistribution = M.fromList v2 = coinVal coin2 v3 = coinVal coin3 - From ebd8bc2de4354f387559ee4d094ad3ed7b1716be Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 17:37:30 +0300 Subject: [PATCH 32/81] Removes some remnats --- mlabs/mlabs-plutus-use-cases.cabal | 1 - mlabs/src/Mlabs/Lending/Contract/Coin.hs | 31 ----------------------- mlabs/src/Mlabs/Lending/Contract/Utils.hs | 12 --------- 3 files changed, 44 deletions(-) delete mode 100644 mlabs/src/Mlabs/Lending/Contract/Coin.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index a8ce49b9d..0d3a33b17 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -43,7 +43,6 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: - Mlabs.Lending.Contract.Coin Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex Mlabs.Lending.Contract.Utils diff --git a/mlabs/src/Mlabs/Lending/Contract/Coin.hs b/mlabs/src/Mlabs/Lending/Contract/Coin.hs deleted file mode 100644 index 41cbb4784..000000000 --- a/mlabs/src/Mlabs/Lending/Contract/Coin.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# options_ghc -fno-warn-orphans #-} -{-# OPTIONS_GHC -fno-specialize #-} -{-# OPTIONS_GHC -fno-specialize #-} -module Mlabs.Lending.Contract.Coin where - -import PlutusTx.Prelude (Integer, Bool, Eq(..)) - -import Ledger hiding (singleton) -import Ledger.Value (AssetClass (..), assetClassValue, assetClassValueOf, assetClass) -import Playground.Contract (ToSchema) - -type Coin = AssetClass -deriving anyclass instance ToSchema AssetClass - -{-# INLINABLE coin #-} -coin :: AssetClass -> Integer -> Value -coin = assetClassValue - -{-# INLINABLE coinValueOf #-} -coinValueOf :: Value -> AssetClass -> Integer -coinValueOf = assetClassValueOf - -{-# INLINABLE mkCoin #-} -mkCoin:: CurrencySymbol -> TokenName -> AssetClass -mkCoin = assetClass - -{-# INLINABLE hasCoinValue #-} --- | We check that value for coin is present and equals to 1. --- It serves as a marker of coin presence. -hasCoinValue :: Value -> Coin -> Bool -hasCoinValue val c = coinValueOf val c == 1 diff --git a/mlabs/src/Mlabs/Lending/Contract/Utils.hs b/mlabs/src/Mlabs/Lending/Contract/Utils.hs index 9289be92e..c3e18959f 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Utils.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Utils.hs @@ -3,21 +3,9 @@ module Mlabs.Lending.Contract.Utils where import Prelude (Maybe(..), ($)) - -import PlutusTx.Prelude ((.), error) -import qualified PlutusTx.Prelude as Plutus import Ledger hiding (singleton) - import PlutusTx -{-# INLINABLE valueWithin #-} -valueWithin :: TxInInfo -> Value -valueWithin = txOutValue . txInInfoResolved - -{-# INLINABLE findOwnInput' #-} -findOwnInput' :: ScriptContext -> TxInInfo -findOwnInput' ctx = Plutus.fromMaybe (error ()) (findOwnInput ctx) - -- | For off-chain code readDatum :: IsData a => TxOutTx -> Maybe a readDatum txOut = do From 7cd5024960eb0f490e091b2646d19cb60160d695 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 14 May 2021 17:37:30 +0300 Subject: [PATCH 33/81] Removes some remnats --- mlabs/mlabs-plutus-use-cases.cabal | 1 - mlabs/src/Mlabs/Lending/Contract/Coin.hs | 31 ----------------------- mlabs/src/Mlabs/Lending/Contract/Utils.hs | 12 --------- 3 files changed, 44 deletions(-) delete mode 100644 mlabs/src/Mlabs/Lending/Contract/Coin.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index a8ce49b9d..0d3a33b17 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -43,7 +43,6 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: - Mlabs.Lending.Contract.Coin Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex Mlabs.Lending.Contract.Utils diff --git a/mlabs/src/Mlabs/Lending/Contract/Coin.hs b/mlabs/src/Mlabs/Lending/Contract/Coin.hs deleted file mode 100644 index 41cbb4784..000000000 --- a/mlabs/src/Mlabs/Lending/Contract/Coin.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# options_ghc -fno-warn-orphans #-} -{-# OPTIONS_GHC -fno-specialize #-} -{-# OPTIONS_GHC -fno-specialize #-} -module Mlabs.Lending.Contract.Coin where - -import PlutusTx.Prelude (Integer, Bool, Eq(..)) - -import Ledger hiding (singleton) -import Ledger.Value (AssetClass (..), assetClassValue, assetClassValueOf, assetClass) -import Playground.Contract (ToSchema) - -type Coin = AssetClass -deriving anyclass instance ToSchema AssetClass - -{-# INLINABLE coin #-} -coin :: AssetClass -> Integer -> Value -coin = assetClassValue - -{-# INLINABLE coinValueOf #-} -coinValueOf :: Value -> AssetClass -> Integer -coinValueOf = assetClassValueOf - -{-# INLINABLE mkCoin #-} -mkCoin:: CurrencySymbol -> TokenName -> AssetClass -mkCoin = assetClass - -{-# INLINABLE hasCoinValue #-} --- | We check that value for coin is present and equals to 1. --- It serves as a marker of coin presence. -hasCoinValue :: Value -> Coin -> Bool -hasCoinValue val c = coinValueOf val c == 1 diff --git a/mlabs/src/Mlabs/Lending/Contract/Utils.hs b/mlabs/src/Mlabs/Lending/Contract/Utils.hs index 9289be92e..c3e18959f 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Utils.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Utils.hs @@ -3,21 +3,9 @@ module Mlabs.Lending.Contract.Utils where import Prelude (Maybe(..), ($)) - -import PlutusTx.Prelude ((.), error) -import qualified PlutusTx.Prelude as Plutus import Ledger hiding (singleton) - import PlutusTx -{-# INLINABLE valueWithin #-} -valueWithin :: TxInInfo -> Value -valueWithin = txOutValue . txInInfoResolved - -{-# INLINABLE findOwnInput' #-} -findOwnInput' :: ScriptContext -> TxInInfo -findOwnInput' ctx = Plutus.fromMaybe (error ()) (findOwnInput ctx) - -- | For off-chain code readDatum :: IsData a => TxOutTx -> Maybe a readDatum txOut = do From f6cf3ab1be686620f62ebb175c1f391f88bf4898 Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 17 May 2021 19:54:15 +0300 Subject: [PATCH 34/81] update prices of the currencies --- mlabs/mlabs-plutus-use-cases.cabal | 3 + mlabs/src/Mlabs/Data/AssocMap.hs | 14 +++ mlabs/src/Mlabs/Data/List.hs | 100 ++++++++++++++++++ mlabs/src/Mlabs/Data/Ord.hs | 18 ++++ mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 4 +- mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs | 8 +- .../Mlabs/Lending/Logic/Emulator/Script.hs | 9 +- mlabs/src/Mlabs/Lending/Logic/React.hs | 83 ++++++++++++--- mlabs/src/Mlabs/Lending/Logic/State.hs | 27 +++-- mlabs/src/Mlabs/Lending/Logic/Types.hs | 67 ++++++++++-- 10 files changed, 296 insertions(+), 37 deletions(-) create mode 100644 mlabs/src/Mlabs/Data/AssocMap.hs create mode 100644 mlabs/src/Mlabs/Data/List.hs create mode 100644 mlabs/src/Mlabs/Data/Ord.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 0d3a33b17..7f5bf9510 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -43,6 +43,9 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: + Mlabs.Data.AssocMap + Mlabs.Data.List + Mlabs.Data.Ord Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex Mlabs.Lending.Contract.Utils diff --git a/mlabs/src/Mlabs/Data/AssocMap.hs b/mlabs/src/Mlabs/Data/AssocMap.hs new file mode 100644 index 000000000..bcbff01d6 --- /dev/null +++ b/mlabs/src/Mlabs/Data/AssocMap.hs @@ -0,0 +1,14 @@ +-- | Missing plutus functions for AssocMap's +module Mlabs.Data.AssocMap( + filter +) where + +import PlutusTx.Prelude (Bool, (.), ($), snd) + +import qualified PlutusTx.Prelude as Plutus (filter) +import PlutusTx.AssocMap (Map) +import qualified PlutusTx.AssocMap as M + +filter :: (v -> Bool) -> Map k v -> Map k v +filter f m = M.fromList $ Plutus.filter (f . snd) $ M.toList m + diff --git a/mlabs/src/Mlabs/Data/List.hs b/mlabs/src/Mlabs/Data/List.hs new file mode 100644 index 000000000..f5cc58c22 --- /dev/null +++ b/mlabs/src/Mlabs/Data/List.hs @@ -0,0 +1,100 @@ +-- | Missing plutus functions for Lists +module Mlabs.Data.List( + take + , sortOn + , sortBy + , mapM_ +) where + +import PlutusTx.Prelude hiding (take, mapM_) +import Mlabs.Data.Ord (comparing) + +{-# INLINABLE take #-} +-- | 'take' @n@, applied to a list @xs@, returns the prefix of @xs@ +-- of length @n@, or @xs@ itself if @n > 'length' xs@. +-- +-- >>> take 5 "Hello World!" +-- "Hello" +-- >>> take 3 [1,2,3,4,5] +-- [1,2,3] +-- >>> take 3 [1,2] +-- [1,2] +-- >>> take 3 [] +-- [] +-- >>> take (-1) [1,2] +-- [] +-- >>> take 0 [1,2] +-- [] +-- +-- It is an instance of the more general 'Data.List.genericTake', +-- in which @n@ may be of any integral type. +take :: Integer -> [a] -> [a] +take n + | n <= 0 = const [] + | otherwise = \case + [] -> [] + a:as -> a : take (n - 1) as + +{-# INLINABLE sortOn #-} +-- | Sort a list by comparing the results of a key function applied to each +-- element. @sortOn f@ is equivalent to @sortBy (comparing f)@, but has the +-- performance advantage of only evaluating @f@ once for each element in the +-- input list. This is called the decorate-sort-undecorate paradigm, or +-- Schwartzian transform. +-- +-- Elements are arranged from lowest to highest, keeping duplicates in +-- the order they appeared in the input. +-- +-- >>> sortOn fst [(2, "world"), (4, "!"), (1, "Hello")] +-- [(1,"Hello"),(2,"world"),(4,"!")] +sortOn :: Ord b => (a -> b) -> [a] -> [a] +sortOn f = + map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) + +{-# INLINABLE sortBy #-} +-- | The 'sortBy' function is the non-overloaded version of 'sort'. +-- +-- >>> sortBy (\(a,_) (b,_) -> compare a b) [(2, "world"), (4, "!"), (1, "Hello")] +-- [(1,"Hello"),(2,"world"),(4,"!")] +sortBy :: (a -> a -> Ordering) -> [a] -> [a] +sortBy cmp = mergeAll . sequences + where + sequences (a:b:xs) = case a `cmp` b of + GT -> descending b [a] xs + _ -> ascending b (a:) xs + sequences xs = [xs] + + descending a as (b:bs) = case a `cmp` b of + GT -> descending b (a:as) bs + _ -> (a:as): sequences bs + descending a as bs = (a:as): sequences bs + + ascending a as (b:bs) = case a `cmp` b of + GT -> let !x = as [a] + in x : sequences bs + _ -> ascending b (\ys -> as (a:ys)) bs + ascending a as bs = let !x = as [a] + in x : sequences bs + + mergeAll [x] = x + mergeAll xs = mergeAll (mergePairs xs) + + mergePairs (a:b:xs) = let !x = merge a b + in x : mergePairs xs + mergePairs xs = xs + + merge as@(a:as') bs@(b:bs') = case a `cmp` b of + GT -> b:merge as bs' + _ -> a:merge as' bs + merge [] bs = bs + merge as [] = as + + +{-# INLINABLE mapM_ #-} +mapM_ :: Monad f => (a -> f ()) -> [a] -> f () +mapM_ f = \case + [] -> return () + a:as -> do + _ <- f a + mapM_ f as + diff --git a/mlabs/src/Mlabs/Data/Ord.hs b/mlabs/src/Mlabs/Data/Ord.hs new file mode 100644 index 000000000..baf535c17 --- /dev/null +++ b/mlabs/src/Mlabs/Data/Ord.hs @@ -0,0 +1,18 @@ +-- | Missing plutus functions for Ord. +module Mlabs.Data.Ord( + comparing +) where + +import PlutusTx.Prelude + +{-# INLINABLE comparing #-} +-- | +-- > comparing p x y = compare (p x) (p y) +-- +-- Useful combinator for use in conjunction with the @xxxBy@ family +-- of functions from "Data.List", for example: +-- +-- > ... sortBy (comparing fst) ... +comparing :: (Ord a) => (b -> a) -> b -> b -> Ordering +comparing p x y = compare (p x) (p y) + diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index a81b66bca..19b69d417 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -73,6 +73,7 @@ machine = (SM.mkStateMachine Nothing transition isFinal) getInputTime = \case UserAct time _ _ -> Just time + PriceAct time _ -> Just time _ -> Nothing @@ -156,7 +157,8 @@ type PriceOracleApp a = Contract () PriceOracleLendexSchema LendexError a priceOracleAction :: PriceAct -> PriceOracleApp () priceOracleAction act = do - void $ SM.runStep client (PriceAct act) + currentTimestamp <- getSlot <$> currentSlot + void $ SM.runStep client (PriceAct currentTimestamp act) -- | Endpoints for price oracle priceOracleEndpoints :: PriceOracleApp () diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs index 899c2ab6b..f9e6a8ca5 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs @@ -69,7 +69,13 @@ data AppConfig = AppConfig -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: AppConfig -> App initApp AppConfig{..} = App - { app'pool = LendingPool (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) AM.empty appConfig'currencySymbol coinMap + { app'pool = LendingPool + { lp'reserves = (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) + , lp'users = AM.empty + , lp'currency = appConfig'currencySymbol + , lp'coinMap = coinMap + , lp'healthReport = AM.empty + } , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users } diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs index 9489a1768..99c8cc394 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs @@ -43,15 +43,20 @@ runScript :: Script -> [Act] runScript (Script actions) = toList $ st'acts $ execState actions (St Seq.empty 0) +getCurrentTime :: ScriptM Integer +getCurrentTime = gets (getSum . st'time) + -- | Make user act userAct :: UserId -> UserAct -> Script userAct uid act = do - time <- gets (getSum . st'time) + time <- getCurrentTime putAct $ UserAct time uid act -- | Make price act priceAct :: PriceAct -> Script -priceAct arg = putAct $ PriceAct arg +priceAct arg = do + t <- getCurrentTime + putAct $ PriceAct t arg -- | Make govern act governAct :: GovernAct -> Script diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 836ca41a9..3919a5207 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -16,15 +16,19 @@ import qualified PlutusTx.Ratio as R import qualified PlutusTx.Numeric as N import PlutusTx.Prelude import qualified PlutusTx.AssocMap as M +import qualified PlutusTx.These as PlutusTx -import Control.Monad.Except -import Control.Monad.State.Strict +import Control.Monad.Except hiding (Functor(..), mapM) +import Control.Monad.State.Strict hiding (Functor(..), mapM) import Mlabs.Lending.Logic.Emulator.Blockchain import Mlabs.Lending.Logic.InterestRate (addDeposit) import Mlabs.Lending.Logic.State import Mlabs.Lending.Logic.Types +import qualified Mlabs.Data.AssocMap as M +import qualified Mlabs.Data.List as L + {-# INLINABLE react #-} -- | State transitions for lending pool. -- For a given action we update internal state of Lending pool and produce @@ -33,8 +37,8 @@ react :: Act -> St [Resp] react input = do checkInput input case input of - UserAct t uid act -> userAct t uid act - PriceAct act -> priceAct act + UserAct t uid act -> withHealthCheck t $ userAct t uid act + PriceAct t act -> withHealthCheck t $ priceAct t act GovernAct act -> governAct act where -- | User acts @@ -185,13 +189,16 @@ react input = do liquidationCallAct _ _ _ _ _ _ = todo --------------------------------------------------- - priceAct = \case - SetAssetPrice coin rate -> setAssetPrice coin rate + priceAct currentTime = \case + SetAssetPrice coin rate -> setAssetPrice currentTime coin rate SetOracleAddr coin addr -> setOracleAddr coin addr --------------------------------------------------- -- update on market price change - setAssetPrice _ _ = todo + + setAssetPrice currentTime asset rate = do + modifyReserve asset $ \r -> r { reserve'rate = CoinRate rate currentTime } + pure [] --------------------------------------------------- -- set oracle address @@ -208,15 +215,52 @@ react input = do -- Adds new reserve (new coin/asset) addReserve cfg@CoinCfg{..} = do - LendingPool reserves users curSym coinMap <- get + LendingPool reserves users curSym coinMap healthReport <- get if M.member coinCfg'coin reserves then throwError "Reserve is already present" else do let newReserves = M.insert coinCfg'coin (initReserve cfg) reserves newCoinMap = M.insert coinCfg'aToken coinCfg'coin coinMap - put $ LendingPool newReserves users curSym newCoinMap + put $ LendingPool newReserves users curSym newCoinMap healthReport return [] + --------------------------------------------------- + -- health checks + + withHealthCheck time act = do + res <- act + updateHealthChecks time + return res + + updateHealthChecks currentTime = do + us <- getUsersForUpdate + newUsers <- M.fromList <$> mapM (updateUserHealth currentTime) us + modifyUsers $ \users -> batchInsert newUsers users + where + getUsersForUpdate = do + us <- fmap setTimestamp . M.toList <$> gets lp'users + pure $ fmap snd $ L.take userUpdateSpan $ L.sortOn fst us + + setTimestamp (uid, user) = (user'lastUpdateTime user - currentTime, (uid, user)) + + updateUserHealth currentTime (uid, user) = do + health <- mapM (\asset -> (asset, ) <$> getHealth 0 asset user) userBorrows + L.mapM_ (reportUserHealth uid) $ health + pure (uid, user { user'lastUpdateTime = currentTime + , user'health = M.fromList health }) + where + userBorrows = M.keys $ M.filter ((> 0) . wallet'borrow) $ user'wallets user + + reportUserHealth uid (asset, health) + | health >= R.fromInteger 1 = modifyHealthReport $ M.delete (BadBorrow uid asset) + | otherwise = modifyHealthReport $ M.insert (BadBorrow uid asset) health + + -- insert m1 to m2 + batchInsert m1 m2 = fmap (PlutusTx.these id id const) $ M.union m1 m2 + + -- how many users to update per iteration of update health checks + userUpdateSpan = 10 + todo = return [] {-# INLINABLE checkInput #-} @@ -226,7 +270,7 @@ checkInput = \case UserAct time _uid act -> do isNonNegative "timestamp" time checkUserAct act - PriceAct act -> checkPriceAct act + PriceAct time act -> checkPriceAct time act GovernAct act -> checkGovernAct act where checkUserAct = \case @@ -250,12 +294,15 @@ checkInput = \case LiquidationCallAct _collateral _debt _user debtToCover _receiveAToken -> isPositive "Debt to cover" debtToCover - checkPriceAct = \case - SetAssetPrice asset price -> do - isPositiveRational "price" price - isAsset asset - SetOracleAddr asset _uid -> - isAsset asset + checkPriceAct time act = do + isNonNegative "price rate timestamp" time + case act of + SetAssetPrice asset price -> do + checkCoinRateTimeProgress time asset + isPositiveRational "price" price + isAsset asset + SetOracleAddr asset _uid -> + isAsset asset checkGovernAct = \case AddReserve cfg -> checkCoinCfg cfg @@ -269,3 +316,7 @@ checkInput = \case isPositiveRational "slope 1" im'slope1 isPositiveRational "slope 2" im'slope2 + checkCoinRateTimeProgress time asset = do + lastUpdateTime <- coinRate'lastUpdateTime . reserve'rate <$> getReserve asset + isNonNegative "Timestamps for price update should grow" (time - lastUpdateTime) + diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 0018a3360..3f9e17eaf 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -25,6 +25,7 @@ module Mlabs.Lending.Logic.State( , getLiquidationThreshold , getHealth , getHealthCheck + , modifyUsers , modifyReserve , modifyReserveWallet , modifyUser @@ -35,6 +36,7 @@ module Mlabs.Lending.Logic.State( , modifyUser' , modifyWallet' , modifyWalletAndReserve' + , modifyHealthReport , getNormalisedIncome , getCumulativeBalance ) where @@ -42,6 +44,7 @@ module Mlabs.Lending.Logic.State( import qualified PlutusTx.Ratio as R import qualified PlutusTx.Numeric as N import PlutusTx.Prelude +import PlutusTx.AssocMap (Map) import qualified PlutusTx.AssocMap as M import Control.Monad.Except hiding (Functor(..), mapM) @@ -164,7 +167,7 @@ getReserve coin = do -- | Convert given currency to base currency toAda :: Coin -> Integer -> St Integer toAda coin val = do - ratio <- fmap reserve'rate $ getReserve coin + ratio <- fmap (coinRate'value . reserve'rate) $ getReserve coin pure $ R.round $ R.fromInteger val N.* ratio {-# INLINABLE weightedTotal #-} @@ -175,7 +178,7 @@ weightedTotal = fmap sum . mapM (uncurry toAda) {-# INLINABLE walletTotal #-} -- | Collects cumulative value for given wallet field walletTotal :: (Wallet -> Integer) -> User -> St Integer -walletTotal extract (User ws) = weightedTotal $ M.toList $ fmap extract ws +walletTotal extract (User ws _ _) = weightedTotal $ M.toList $ fmap extract ws {-# INLINABLE getTotalCollateral #-} -- | Gets total collateral for a user. @@ -213,6 +216,10 @@ getLiquidationThreshold :: Coin -> St Rational getLiquidationThreshold coin = gets (maybe (R.fromInteger 0) reserve'liquidationThreshold . M.lookup coin . lp'reserves) +{-# INLINABLE modifyUsers #-} +modifyUsers :: (Map UserId User -> Map UserId User) -> St () +modifyUsers f = modify' $ \lp -> lp { lp'users = f $ lp'users lp } + {-# INLINABLE modifyReserve #-} -- | Modify reserve for a given asset. modifyReserve :: Coin -> (Reserve -> Reserve) -> St () @@ -222,9 +229,9 @@ modifyReserve coin f = modifyReserve' coin (Right . f) -- | Modify reserve for a given asset. It can throw errors. modifyReserve' :: Coin -> (Reserve -> Either Error Reserve) -> St () modifyReserve' asset f = do - LendingPool lp users curSym coinMap <- get + LendingPool lp users curSym coinMap healthReport <- get case M.lookup asset lp of - Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym coinMap) (f reserve) + Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym coinMap healthReport) (f reserve) Nothing -> throwError $ "Asset is not supported" {-# INLINABLE modifyUser #-} @@ -236,10 +243,14 @@ modifyUser uid f = modifyUser' uid (Right . f) -- | Modify user info by id. It can throw errors. modifyUser' :: UserId -> (User -> Either Error User) -> St () modifyUser' uid f = do - LendingPool lp users curSym coinMap <- get + LendingPool lp users curSym coinMap healthReport <- get case f $ fromMaybe defaultUser $ M.lookup uid users of Left msg -> throwError msg - Right user -> put $ LendingPool lp (M.insert uid user users) curSym coinMap + Right user -> put $ LendingPool lp (M.insert uid user users) curSym coinMap healthReport + +{-# INLINABLE modifyHealthReport #-} +modifyHealthReport :: (HealthReport -> HealthReport) -> St () +modifyHealthReport f = modify' $ \lp -> lp { lp'healthReport = f $ lp'healthReport lp } {-# INLINABLE modifyWalletAndReserve #-} -- | Modify user wallet and reserve wallet with the same function. @@ -273,9 +284,9 @@ modifyWallet uid coin f = modifyWallet' uid coin (Right . f) -- | Modify internal user wallet that is allocated for a given user id and asset. -- It can throw errors. modifyWallet' :: UserId -> Coin -> (Wallet -> Either Error Wallet) -> St () -modifyWallet' uid coin f = modifyUser' uid $ \(User ws) -> do +modifyWallet' uid coin f = modifyUser' uid $ \(User ws time health) -> do wal <- f $ fromMaybe defaultWallet $ M.lookup coin ws - pure $ User $ M.insert coin wal ws + pure $ User (M.insert coin wal ws) time health {-# INLINABLE getNormalisedIncome #-} getNormalisedIncome :: Coin -> St Rational diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index ecd61207a..1d1d26d6e 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -24,10 +24,13 @@ module Mlabs.Lending.Logic.Types( , InterestModel(..) , defaultInterestModel , CoinCfg(..) + , CoinRate(..) , initReserve , initLendingPool , Act(..) , UserAct(..) + , HealthReport + , BadBorrow(..) , PriceAct(..) , GovernAct(..) , LpAddressesProvider(..) @@ -75,10 +78,11 @@ instance Eq UserId where -- | Lending pool is a list of reserves data LendingPool = LendingPool - { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves - , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app - , lp'currency :: !CurrencySymbol -- ^ main currencySymbol of the app - , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins + { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves + , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app + , lp'currency :: !CurrencySymbol -- ^ main currencySymbol of the app + , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins + , lp'healthReport :: !HealthReport -- ^ map of unhealthy borrows } deriving (Show, Generic) @@ -86,13 +90,34 @@ data LendingPool = LendingPool -- It holds all info on individual collaterals and deposits. data Reserve = Reserve { reserve'wallet :: !Wallet -- ^ total amounts of coins deposited to reserve - , reserve'rate :: !Rational -- ^ ratio of reserve's coin to base currency + , reserve'rate :: !CoinRate -- ^ ratio of reserve's coin to base currency , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin , reserve'aToken :: !TokenName -- ^ aToken corresponding to the coin of the reserve , reserve'interest :: !ReserveInterest -- ^ reserve liquidity params } deriving (Show, Generic) +type HealthReport = Map BadBorrow Rational + +-- | Borrow that don't has enough collateral. +-- It has health check ration below one. +data BadBorrow = BadBorrow + { badBorrow'userId :: !UserId -- ^ user identifier + , badBorrow'asset :: !Coin -- ^ asset of the borrow + } + deriving (Show, Generic) + +instance Eq BadBorrow where + {-# INLINABLE (==) #-} + BadBorrow a1 b1 == BadBorrow a2 b2 = a1 == a2 && b1 == b2 + +-- | Price of the given currency to Ada. +data CoinRate = CoinRate + { coinRate'value :: !Rational -- ^ ratio to ada + , coinRate'lastUpdateTime :: !Integer -- ^ last time price was updated + } + deriving (Show, Generic) + -- | Parameters for calculation of interest rates. data ReserveInterest = ReserveInterest { ri'interestModel :: !InterestModel @@ -132,7 +157,14 @@ data CoinCfg = CoinCfg {-# INLINABLE initLendingPool #-} initLendingPool :: CurrencySymbol -> [CoinCfg] -> LendingPool -initLendingPool curSym coinCfgs = LendingPool reserves M.empty curSym coinMap +initLendingPool curSym coinCfgs = + LendingPool + { lp'reserves = reserves + , lp'users = M.empty + , lp'currency = curSym + , lp'coinMap = coinMap + , lp'healthReport = M.empty + } where reserves = M.fromList $ fmap (\cfg -> (coinCfg'coin cfg, initReserve cfg)) coinCfgs coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken _) -> (aToken, coin)) coinCfgs @@ -147,7 +179,10 @@ initReserve CoinCfg{..} = Reserve , wallet'collateral = 0 , wallet'scaledBalance = R.fromInteger 0 } - , reserve'rate = coinCfg'rate + , reserve'rate = CoinRate + { coinRate'value = coinCfg'rate + , coinRate'lastUpdateTime = 0 + } , reserve'liquidationThreshold = 8 % 10 , reserve'aToken = coinCfg'aToken , reserve'interest = initInterest coinCfg'interestModel @@ -164,13 +199,22 @@ initReserve CoinCfg{..} = Reserve -- | User is a set of wallets per currency data User = User { user'wallets :: !(Map Coin Wallet) + , user'lastUpdateTime :: !Integer + , user'health :: !Health } deriving (Show, Generic) +-- | Health ratio for user per borrow +type Health = Map Coin Rational + {-# INLINABLE defaultUser #-} -- | Default user with no wallets. defaultUser :: User -defaultUser = User { user'wallets = M.empty } +defaultUser = User + { user'wallets = M.empty + , user'lastUpdateTime = 0 + , user'health = M.empty + } -- | Internal walet of the lending app -- @@ -195,7 +239,10 @@ data Act , userAct'userId :: UserId , userAct'act :: UserAct } -- ^ user's actions - | PriceAct PriceAct -- ^ price oracle's actions + | PriceAct + { priceAct'time :: Integer + , priceAct'act :: PriceAct + } -- ^ price oracle's actions | GovernAct GovernAct -- ^ app admin's actions deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON) @@ -302,6 +349,7 @@ data InterestRate = StableRate | VariableRate -- boilerplate instances PlutusTx.unstableMakeIsData ''CoinCfg +PlutusTx.unstableMakeIsData ''CoinRate PlutusTx.unstableMakeIsData ''InterestModel PlutusTx.unstableMakeIsData ''InterestRate PlutusTx.unstableMakeIsData ''ReserveInterest @@ -312,6 +360,7 @@ PlutusTx.unstableMakeIsData ''UserId PlutusTx.unstableMakeIsData ''User PlutusTx.unstableMakeIsData ''Wallet PlutusTx.unstableMakeIsData ''Reserve +PlutusTx.unstableMakeIsData ''BadBorrow PlutusTx.unstableMakeIsData ''LendingPool PlutusTx.unstableMakeIsData ''Act From 8faed6cf336ce58c603f719d497e867246c4fac0 Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 18 May 2021 16:11:20 +0300 Subject: [PATCH 35/81] Implements liquidation of the borrow --- mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs | 9 ++- mlabs/src/Mlabs/Lending/Logic/React.hs | 81 ++++++++++++++++++- mlabs/src/Mlabs/Lending/Logic/State.hs | 38 +++++++++ mlabs/src/Mlabs/Lending/Logic/Types.hs | 52 +++++++----- mlabs/test/Test/Lending/Contract.hs | 1 + mlabs/test/Test/Lending/Logic.hs | 9 ++- 6 files changed, 161 insertions(+), 29 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs index f9e6a8ca5..7a6e204b1 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs @@ -92,7 +92,14 @@ defaultAppConfig = AppConfig reserves users curSym userNames = ["1", "2", "3"] coinNames = ["Dollar", "Euro", "Lira"] - reserves = fmap (\name -> CoinCfg (toCoin name) (R.fromInteger 1) (toAToken name) defaultInterestModel) coinNames + reserves = fmap (\name -> + CoinCfg + { coinCfg'coin = toCoin name + , coinCfg'rate = R.fromInteger 1 + , coinCfg'aToken = toAToken name + , coinCfg'interestModel = defaultInterestModel + , coinCfg'liquidationBonus = 5 % 100 + }) coinNames users = zipWith (\coinName userName -> (UserId (PubKeyHash userName), wal (toCoin coinName, 100))) coinNames userNames wal cs = BchWallet $ uncurry M.singleton cs diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 3919a5207..b13d7336d 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -50,7 +50,7 @@ react input = do SetUserReserveAsCollateralAct{..} -> setUserReserveAsCollateralAct uid act'asset act'useAsCollateral (min act'portion (R.fromInteger 1)) WithdrawAct{..} -> withdrawAct time uid act'amount act'asset FlashLoanAct -> flashLoanAct uid - LiquidationCallAct{..} -> liquidationCallAct uid act'collateral act'debt act'user act'debtToCover act'receiveAToken + LiquidationCallAct{..} -> liquidationCallAct time uid act'collateral act'debt act'debtToCover act'receiveAToken --------------------------------------------------- -- deposit @@ -186,7 +186,73 @@ react input = do --------------------------------------------------- -- liquidation call - liquidationCallAct _ _ _ _ _ _ = todo + liquidationCallAct currentTime uid collateralAsset debt amountCovered receiveATokens = do + isBadBorrow debt + wals <- getsUser (badBorrow'userId debt) user'wallets + bor <- getDebtValue wals + col <- getCollateralValue wals + isPositive "liquidation collateral" col + debtAmountIsLessThanHalf bor amountCovered + colCovered <- min col <$> getCollateralCovered amountCovered + adaBonus <- getBonus colCovered + aCollateralAsset <- aToken collateralAsset + updateBorrowUser colCovered + updateRepayUser colCovered + pure $ mconcat + [ moveFromTo uid Self borrowAsset amountCovered + , moveFromTo Self uid (receiveAsset aCollateralAsset) colCovered + , moveFromTo Self uid adaCoin adaBonus + ] + where + borrowAsset = badBorrow'asset debt + borrowUserId = badBorrow'userId debt + + receiveAsset aCoin + | receiveATokens = aCoin + | otherwise = collateralAsset + + getDebtValue wals = case M.lookup borrowAsset wals of + Just wal -> pure $ wallet'borrow wal + Nothing -> throwError "Wallet does not have the debt to liquidate" + + getCollateralValue wals = case M.lookup collateralAsset wals of + Just wal -> pure $ wallet'collateral wal + Nothing -> throwError "Wallet does not have collateral for liquidation asset" + + debtToColateral = convertCoin Convert + { convert'from = borrowAsset + , convert'to = collateralAsset + } + + getCollateralCovered amount = debtToColateral amount + + getBonus amount = do + rate <- getLiquidationBonus collateralAsset + toAda collateralAsset $ R.round $ R.fromInteger amount * rate + + debtAmountIsLessThanHalf userDebt amount + | userDebt >= 2 * amount = pure () + | otherwise = throwError "Can not cover more than half of the borrow" + + -- we remove part of the borrow from the user and part of the collateral + updateBorrowUser colCovered = do + modifyWalletAndReserve borrowUserId collateralAsset $ \w -> + w { wallet'collateral = wallet'collateral w - colCovered } + modifyWalletAndReserve borrowUserId borrowAsset $ \w -> + w { wallet'borrow = wallet'borrow w - amountCovered } + updateSingleUserHealth currentTime borrowUserId + + -- we add borrower's collateral to repaier deposit if repaier chooses to receive aTokens. + -- if we pay in real currency repaier stays the same. + updateRepayUser colCovered + | receiveATokens = do + ni <- getNormalisedIncome collateralAsset + modifyWalletAndReserve' uid collateralAsset $ addDeposit ni colCovered + | otherwise = pure () + + isBadBorrow bor = do + isOk <- M.member bor <$> gets lp'healthReport + guardError "Bad borrow not present" isOk --------------------------------------------------- priceAct currentTime = \case @@ -243,6 +309,11 @@ react input = do setTimestamp (uid, user) = (user'lastUpdateTime user - currentTime, (uid, user)) + updateSingleUserHealth currentTime uid = do + user <- getUser uid + newUser <- snd <$> updateUserHealth currentTime (uid, user) + modifyUser uid $ const newUser + updateUserHealth currentTime (uid, user) = do health <- mapM (\asset -> (asset, ) <$> getHealth 0 asset user) userBorrows L.mapM_ (reportUserHealth uid) $ health @@ -291,7 +362,8 @@ checkInput = \case isPositive "withdraw" amount isAsset asset FlashLoanAct -> pure () - LiquidationCallAct _collateral _debt _user debtToCover _receiveAToken -> + LiquidationCallAct collateral _debt debtToCover _recieveAToken -> do + isAsset collateral isPositive "Debt to cover" debtToCover checkPriceAct time act = do @@ -308,8 +380,9 @@ checkInput = \case AddReserve cfg -> checkCoinCfg cfg checkCoinCfg CoinCfg{..} = do - isPositiveRational "coin price" coinCfg'rate + isPositiveRational "coin price config" coinCfg'rate checkInterestModel coinCfg'interestModel + isUnitRange "liquidation bonus config" coinCfg'liquidationBonus checkInterestModel InterestModel{..} = do isUnitRange "optimal utilisation" im'optimalUtilisation diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 3f9e17eaf..a2914d0e8 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -19,10 +19,15 @@ module Mlabs.Lending.Logic.State( , getUser, getsUser , getReserve, getsReserve , toAda + , fromAda + , Convert(..) + , reverseConvert + , convertCoin , getTotalCollateral , getTotalBorrow , getTotalDeposit , getLiquidationThreshold + , getLiquidationBonus , getHealth , getHealthCheck , modifyUsers @@ -170,6 +175,33 @@ toAda coin val = do ratio <- fmap (coinRate'value . reserve'rate) $ getReserve coin pure $ R.round $ R.fromInteger val N.* ratio +{-# INLINABLE fromAda #-} +-- | Convert given currency from base currency +fromAda :: Coin -> Integer -> St Integer +fromAda coin val = do + ratio <- fmap (coinRate'value . reserve'rate) $ getReserve coin + pure $ R.round $ R.fromInteger val N.* R.recip ratio + +-- | Conversion between coins +data Convert = Convert + { convert'from :: Coin -- ^ convert from + , convert'to :: Coin -- ^ convert to + } + deriving (Show) + +{-# INLINABLE reverseConvert #-} +reverseConvert :: Convert -> Convert +reverseConvert Convert{..} = Convert + { convert'from = convert'to + , convert'to = convert'from + } + +{-# INLINABLE convertCoin #-} +-- | Converts from one currency to another +convertCoin :: Convert -> Integer -> St Integer +convertCoin Convert{..} amount = + fromAda convert'to =<< toAda convert'from amount + {-# INLINABLE weightedTotal #-} -- | Weigted total of currencies in base currency weightedTotal :: [(Coin, Integer)] -> St Integer @@ -216,6 +248,12 @@ getLiquidationThreshold :: Coin -> St Rational getLiquidationThreshold coin = gets (maybe (R.fromInteger 0) reserve'liquidationThreshold . M.lookup coin . lp'reserves) +{-# INLINABLE getLiquidationBonus #-} +-- | Reads liquidation bonus for a give asset. +getLiquidationBonus :: Coin -> St Rational +getLiquidationBonus coin = + gets (maybe (R.fromInteger 0) reserve'liquidationBonus . M.lookup coin . lp'reserves) + {-# INLINABLE modifyUsers #-} modifyUsers :: (Map UserId User -> Map UserId User) -> St () modifyUsers f = modify' $ \lp -> lp { lp'users = f $ lp'users lp } diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 1d1d26d6e..9e33f0629 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -25,6 +25,7 @@ module Mlabs.Lending.Logic.Types( , defaultInterestModel , CoinCfg(..) , CoinRate(..) + , adaCoin , initReserve , initLendingPool , Act(..) @@ -50,10 +51,11 @@ module Mlabs.Lending.Logic.Types( import Data.Aeson (FromJSON, ToJSON) import qualified PlutusTx.Ratio as R -import qualified Prelude as P +import qualified Prelude as Hask import qualified PlutusTx as PlutusTx import PlutusTx.Prelude import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) +import qualified Plutus.V1.Ledger.Ada as Ada import PlutusTx.AssocMap (Map) import qualified PlutusTx.AssocMap as M import GHC.Generics @@ -67,7 +69,7 @@ class Showt a where data UserId = UserId PubKeyHash -- user address | Self -- addres of the lending platform - deriving stock (Show, Generic, P.Eq, P.Ord) + deriving stock (Show, Generic, Hask.Eq, Hask.Ord) deriving anyclass (FromJSON, ToJSON) instance Eq UserId where @@ -92,6 +94,7 @@ data Reserve = Reserve { reserve'wallet :: !Wallet -- ^ total amounts of coins deposited to reserve , reserve'rate :: !CoinRate -- ^ ratio of reserve's coin to base currency , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin + , reserve'liquidationBonus :: !Rational -- ^ ratio of bonus for liquidation of the borrow in collateral of this asset , reserve'aToken :: !TokenName -- ^ aToken corresponding to the coin of the reserve , reserve'interest :: !ReserveInterest -- ^ reserve liquidity params } @@ -105,7 +108,8 @@ data BadBorrow = BadBorrow { badBorrow'userId :: !UserId -- ^ user identifier , badBorrow'asset :: !Coin -- ^ asset of the borrow } - deriving (Show, Generic) + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (ToJSON, FromJSON) instance Eq BadBorrow where {-# INLINABLE (==) #-} @@ -134,7 +138,7 @@ data InterestModel = InterestModel , im'slope2 :: !Rational , im'base :: !Rational } - deriving (Show, Generic, P.Eq) + deriving (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) defaultInterestModel :: InterestModel @@ -147,12 +151,13 @@ defaultInterestModel = InterestModel -- | Coin configuration data CoinCfg = CoinCfg - { coinCfg'coin :: Coin - , coinCfg'rate :: Rational - , coinCfg'aToken :: TokenName - , coinCfg'interestModel :: InterestModel + { coinCfg'coin :: Coin + , coinCfg'rate :: Rational + , coinCfg'aToken :: TokenName + , coinCfg'interestModel :: InterestModel + , coinCfg'liquidationBonus :: Rational } - deriving stock (Show, Generic, P.Eq) + deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) {-# INLINABLE initLendingPool #-} @@ -167,7 +172,11 @@ initLendingPool curSym coinCfgs = } where reserves = M.fromList $ fmap (\cfg -> (coinCfg'coin cfg, initReserve cfg)) coinCfgs - coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken _) -> (aToken, coin)) coinCfgs + coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken _ _) -> (aToken, coin)) coinCfgs + +{-# INLINABLE adaCoin #-} +adaCoin :: Coin +adaCoin = AssetClass (Ada.adaSymbol, Ada.adaToken) {-# INLINABLE initReserve #-} -- | Initialise empty reserve with given ratio of its coin to ada @@ -184,6 +193,7 @@ initReserve CoinCfg{..} = Reserve , coinRate'lastUpdateTime = 0 } , reserve'liquidationThreshold = 8 % 10 + , reserve'liquidationBonus = coinCfg'liquidationBonus , reserve'aToken = coinCfg'aToken , reserve'interest = initInterest coinCfg'interestModel } @@ -244,7 +254,7 @@ data Act , priceAct'act :: PriceAct } -- ^ price oracle's actions | GovernAct GovernAct -- ^ app admin's actions - deriving stock (Show, Generic, P.Eq) + deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) -- | Lending pool action @@ -285,27 +295,29 @@ data UserAct | FlashLoanAct -- TODO -- ^ flash loans happen within the single block of transactions | LiquidationCallAct - { act'collateral :: UserId -- ^ collateral address - , act'debt :: UserId - , act'user :: UserId - , act'debtToCover :: Integer - , act'receiveAToken :: Bool + { act'collateral :: Coin -- ^ which collateral do we take for borrow repay + , act'debt :: BadBorrow -- ^ identifier of the unhealthy borrow + , act'debtToCover :: Integer -- ^ how much of the debt we cover + , act'receiveAToken :: Bool -- ^ if true, the user receives the aTokens equivalent + -- of the purchased collateral. If false, the user receives + -- the underlying asset directly. } -- ^ call to liquidate borrows that are unsafe due to health check - deriving stock (Show, Generic, P.Eq) + -- (see for description) + deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) -- | Acts that can be done by admin users. data GovernAct = AddReserve CoinCfg -- ^ Adds new reserve - deriving stock (Show, Generic, P.Eq) + deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) -- | Updates for the prices of the currencies on the markets data PriceAct = SetAssetPrice Coin Rational -- ^ Set asset price | SetOracleAddr Coin UserId -- ^ Provide address of the oracle - deriving stock (Show, Generic, P.Eq) + deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) -- | Custom currency @@ -342,7 +354,7 @@ data PriceOracleProvider = PriceOracleProvider data InterestRateStrategy = InterestRateStrategy data InterestRate = StableRate | VariableRate - deriving stock (Show, Generic, P.Eq) + deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) --------------------------------------------------------------- diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 9f19aaa55..7d1d64bbc 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -50,6 +50,7 @@ depositScript = do , coinCfg'rate = R.fromInteger 1 , coinCfg'aToken = aCoin , coinCfg'interestModel = defaultInterestModel + , coinCfg'liquidationBonus = 5 R.% 100 }) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] } diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 5d002c26d..81ad37bf5 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -191,10 +191,11 @@ testAppConfig :: AppConfig testAppConfig = AppConfig reserves users lendingPoolCurrency where reserves = fmap (\(coin, aCoin) -> CoinCfg - { coinCfg'coin = coin - , coinCfg'rate = R.fromInteger 1 - , coinCfg'aToken = aCoin - , coinCfg'interestModel = defaultInterestModel + { coinCfg'coin = coin + , coinCfg'rate = R.fromInteger 1 + , coinCfg'aToken = aCoin + , coinCfg'interestModel = defaultInterestModel + , coinCfg'liquidationBonus = 5 R.% 100 }) [(coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] From 3e844b3f3fc1c757c1e9ae78a816a1ac1ecaa6ad Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 18 May 2021 18:09:58 +0300 Subject: [PATCH 36/81] Adds unit test for logic of borrow liquidation call --- mlabs/test/Test/Lending/Logic.hs | 54 ++++++++++++++++++++++++++++++-- 1 file changed, 51 insertions(+), 3 deletions(-) diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 81ad37bf5..bc1d44c3b 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -43,11 +43,12 @@ test = testGroup "Logic" , testCase "Borrow with not enough collateral" testBorrowNotEnoughCollateral , testCase "Withdraw" testWithdraw , testCase "Repay" testRepay + , testGroup "Borrow liquidation" testLiquidationCall ] where testBorrow = testWallets [(user1, w1)] borrowScript where - w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 30), (fromToken aToken1, 0)] + w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 30), (aCoin1, 0)] testDeposit = testWallets [(user1, wal coin1 aToken1), (user2, wal coin2 aToken2), (user3, wal coin3 aToken3)] depositScript where @@ -58,7 +59,7 @@ test = testGroup "Logic" testWithdraw = testWallets [(user1, w1)] withdrawScript where - w1 = BchWallet $ M.fromList [(coin1, 75), (fromToken aToken1, 25)] + w1 = BchWallet $ M.fromList [(coin1, 75), (aCoin1, 25)] -- User: -- * deposits 50 coin1 @@ -74,6 +75,19 @@ test = testGroup "Logic" where w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 10), (fromToken aToken1, 0)] + testLiquidationCall = + [ testCase "get aTokens for collateral" $ + testWallets [(user1, w1), (user2, w2a)] $ liquidationCallScript True + , testCase "get underlying currency for collateral" $ + testWallets [(user1, w1), (user2, w2)] $ liquidationCallScript False + ] + where + w1 = BchWallet $ M.fromList [(coin1, 50), (coin2, 30), (fromToken aToken1, 0)] + -- receive aTokens + w2a = BchWallet $ M.fromList [(coin2, 40), (aCoin2, 50) , (aCoin1, 20), (adaCoin, 1)] + -- receive underlying currency + w2 = BchWallet $ M.fromList [(coin2, 40), (aCoin2, 50) , (coin1, 20), (adaCoin, 1)] + -- | Checks that script runs without errors testScript :: Script -> App testScript script = runApp testAppConfig script @@ -155,6 +169,34 @@ repayScript = do , act'rate = StableRate } +-- | +-- * User 1 lends in coin1 and borrows in coin2 +-- * price for coin2 grows so that collateral is not enough +-- * health check for user 1 becomes bad +-- * user 2 repays part of the borrow and aquires part of the collateral of the user 1 +-- +-- So we should get the balances +-- +-- * init | user1 = 100 $ | user2 = 100 € +-- * after deposit | user1 = 50 $, 50 a$ | user2 = 50 €, 50 a€ +-- * after borrow | user1 = 50 $, 30 € | user2 = 50 €, 50 a€ +-- * after liq call | user1 = 50 $, 30 € | user2 = 40 €, 50 a€, 20 a$, 1 ada : if flag is True +-- * after liq call | user1 = 50 $, 30 € | user2 = 40 €, 50 a€, 20 $, 1 ada : if flag is False +-- +-- user2 pays 10 € for borrow, because at that time Euro to Dollar is 2:1 user2 +-- gets 20 aDollars, and 1 ada as bonus (5% of the collateral (20) which is rounded). +-- User gets aDolars because user provides recieveATokens set to True +liquidationCallScript :: Bool -> Script +liquidationCallScript receiveAToken = do + borrowScript + priceAct $ SetAssetPrice coin2 (R.fromInteger 2) + userAct user2 $ LiquidationCallAct + { act'collateral = coin1 + , act'debt = BadBorrow user1 coin2 + , act'debtToCover = 10 + , act'receiveAToken = receiveAToken + } + --------------------------------- -- constants @@ -184,6 +226,11 @@ aToken1 = tokenName "aDollar" aToken2 = tokenName "aEuro" aToken3 = tokenName "aLira" +aCoin1, aCoin2 :: Coin +aCoin1 = fromToken aToken1 +aCoin2 = fromToken aToken2 +-- aCoin3 = fromToken aToken3 + -- | Default application. -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. @@ -200,7 +247,8 @@ testAppConfig = AppConfig reserves users lendingPoolCurrency [(coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] users = - [ (user1, wal (coin1, 100)) + [ (Self, wal (adaCoin, 1000)) -- script starts with some ada on it + , (user1, wal (coin1, 100)) , (user2, wal (coin2, 100)) , (user3, wal (coin3, 100)) ] From 0f46ecf96216aab608d07cf2c88772a7f9c2d4a6 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 19 May 2021 18:43:28 +0300 Subject: [PATCH 37/81] Liquiadation call unit test for Contract/Plutus --- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 7 ++- mlabs/src/Mlabs/Lending/Logic/React.hs | 9 ---- mlabs/test/Test/Lending/Contract.hs | 52 ++++++++++++++++++++-- mlabs/test/Test/Lending/Init.hs | 9 +++- 4 files changed, 59 insertions(+), 18 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 19b69d417..47b90b84f 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -172,7 +172,8 @@ type GovernLendexSchema = .\/ Endpoint "start-lendex" StartParams data StartParams = StartParams - { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA + { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA + , sp'initValue :: Value -- ^ init value deposited to the lending app } deriving stock (Show, Generic) deriving anyclass (FromJSON, ToJSON) @@ -185,9 +186,7 @@ governAction act = do startLendex :: StartParams -> GovernApp () startLendex StartParams{..} = do - void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins) initValue - where - initValue = PlutusTx.mempty + void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins) sp'initValue -- | Endpoints for admin user governEndpoints :: GovernApp () diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index b13d7336d..8d0dce4ad 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -197,7 +197,6 @@ react input = do adaBonus <- getBonus colCovered aCollateralAsset <- aToken collateralAsset updateBorrowUser colCovered - updateRepayUser colCovered pure $ mconcat [ moveFromTo uid Self borrowAsset amountCovered , moveFromTo Self uid (receiveAsset aCollateralAsset) colCovered @@ -242,14 +241,6 @@ react input = do w { wallet'borrow = wallet'borrow w - amountCovered } updateSingleUserHealth currentTime borrowUserId - -- we add borrower's collateral to repaier deposit if repaier chooses to receive aTokens. - -- if we pay in real currency repaier stays the same. - updateRepayUser colCovered - | receiveATokens = do - ni <- getNormalisedIncome collateralAsset - modifyWalletAndReserve' uid collateralAsset $ addDeposit ni colCovered - | otherwise = pure () - isBadBorrow bor = do isOk <- M.member bor <$> gets lp'healthReport guardError "Bad borrow not present" isOk diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 7d1d64bbc..fff946396 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -11,8 +11,11 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified PlutusTx.Ratio as R -import Mlabs.Lending.Logic.Types (UserAct(..), InterestRate(..), CoinCfg(..), defaultInterestModel) +import Mlabs.Lending.Logic.Types ( UserAct(..), InterestRate(..), CoinCfg(..), defaultInterestModel + , PriceAct(..), BadBorrow(..)) + import qualified Mlabs.Lending.Contract.Lendex as L +import qualified Plutus.V1.Ledger.Value as Value import Test.Utils @@ -27,6 +30,7 @@ test = testGroup "Contract" , testBorrowNotEnoughCollateral , testWithdraw , testRepay + , testLiquidationCall ] where check msg scene = checkPredicateOptions checkOptions msg (checkScene scene) @@ -37,6 +41,11 @@ test = testGroup "Contract" testBorrowNotEnoughCollateral = check "Borrow with not enough collateral" borrowNotEnoughCollateralScene borrowNotEnoughCollateralScript testWithdraw = check "Withdraw (can burn aTokens)" withdrawScene withdrawScript testRepay = check "Repay" repayScene repayScript + testLiquidationCall = testGroup "Liquidation" + [ check "Liquidation call aToken" (liquidationCallScene True) (liquidationCallScript True) + , check "Liquidation call real currency" (liquidationCallScene False) (liquidationCallScript False) + ] + -------------------------------------------------------------------------------- -- deposit test @@ -53,6 +62,7 @@ depositScript = do , coinCfg'liquidationBonus = 5 R.% 100 }) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] + , sp'initValue = Value.assetClassValue adaCoin 1000 } wait 5 userAct1 $ DepositAct 50 coin1 @@ -65,10 +75,11 @@ depositScript = do depositScene :: Scene depositScene = mconcat [ appAddress L.lendexAddress - , appOwns [(coin1, 50), (coin2, 50), (coin3, 50)] + , appOwns [(coin1, 50), (coin2, 50), (coin3, 50), (adaCoin, 1000)] , user w1 coin1 aCoin1 , user w2 coin2 aCoin2 - , user w3 coin3 aCoin3 ] + , user w3 coin3 aCoin3 + , wAdmin `owns` [(adaCoin, -1000)] ] where user wal coin aCoin = wal `owns` [(coin, -50), (aCoin, 50)] @@ -178,9 +189,44 @@ repayScript = do , act'amount = 20 , act'rate = StableRate } + next repayScene :: Scene repayScene = borrowScene <> repayChange where repayChange = mconcat [w1 `owns` [(coin2, -20)], appOwns [(coin2, 20)]] +-------------------------------------------------------------------------------- +-- liquidation call test + +liquidationCallScript :: Bool -> Trace.EmulatorTrace () +liquidationCallScript receiveAToken = do + borrowScript + priceAct $ SetAssetPrice coin2 (R.fromInteger 2) + next + userAct2 $ LiquidationCallAct + { act'collateral = coin1 + , act'debt = BadBorrow (toUserId w1) coin2 + , act'debtToCover = 10 + , act'receiveAToken = receiveAToken + } + next + +liquidationCallScene :: Bool -> Scene +liquidationCallScene receiveAToken = borrowScene <> liquidationCallChange + where + liquidationCallChange = mconcat + [ w2 `owns` [(receiveCoin, 20), (coin2, -10), (adaCoin, 1)] + , appOwns [(adaCoin, -1), (coin2, 10), (receiveCoin, -20)] + ] + + receiveCoin + | receiveAToken = aCoin1 + | otherwise = coin1 + +-------------------------------------------------- +-- names as in script test + +priceAct :: PriceAct -> Trace.EmulatorTrace () +priceAct act = L.callPriceOracleAct w1 act + diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index bd9296fb0..559fca0a1 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -7,6 +7,7 @@ module Test.Lending.Init( , aAda, aToken1, aToken2, aToken3 , aCoin1, aCoin2, aCoin3 , initialDistribution + , toUserId ) where import Prelude @@ -16,12 +17,13 @@ import Control.Lens import Plutus.V1.Ledger.Value (Value, TokenName) import qualified Plutus.V1.Ledger.Ada as Ada import qualified Plutus.V1.Ledger.Value as Value +import Plutus.V1.Ledger.Contexts (pubKeyHash) import qualified Data.Map as M import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace -import Mlabs.Lending.Logic.Types (Coin, UserAct(..)) +import Mlabs.Lending.Logic.Types (Coin, UserAct(..), UserId(..)) import qualified Mlabs.Lending.Logic.Emulator.App as L import qualified Mlabs.Lending.Contract.Lendex as L import qualified Mlabs.Lending.Contract.Forge as Forge @@ -36,6 +38,9 @@ w1 = Wallet 1 w2 = Wallet 2 w3 = Wallet 3 +toUserId :: Wallet -> UserId +toUserId = UserId . pubKeyHash . walletPubKey + -- | Showrtcuts for user actions userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () userAct1 = L.callUserAct w1 @@ -71,7 +76,7 @@ aCoin3 = fromToken aToken3 -- | Initial distribution of wallets for testing initialDistribution :: M.Map Wallet Value initialDistribution = M.fromList - [ (wAdmin, val 1000) + [ (wAdmin, val 2000) , (w1, val 1000 <> v1 100) , (w2, val 1000 <> v2 100) , (w3, val 1000 <> v3 100) From ef20fd8b66d34a6b5326ffe570155c4dedb79907 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 20 May 2021 15:52:54 +0300 Subject: [PATCH 38/81] draft of NFT prototype --- mlabs/mlabs-plutus-use-cases.cabal | 3 ++ mlabs/src/Mlabs/Lending/Logic/State.hs | 4 +- mlabs/src/Mlabs/Nft/Logic/React.hs | 53 ++++++++++++++++++++ mlabs/src/Mlabs/Nft/Logic/State.hs | 67 ++++++++++++++++++++++++++ mlabs/src/Mlabs/Nft/Logic/Types.hs | 43 +++++++++++++++++ 5 files changed, 168 insertions(+), 2 deletions(-) create mode 100644 mlabs/src/Mlabs/Nft/Logic/React.hs create mode 100644 mlabs/src/Mlabs/Nft/Logic/State.hs create mode 100644 mlabs/src/Mlabs/Nft/Logic/Types.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 7f5bf9510..291dfb511 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -56,6 +56,9 @@ library Mlabs.Lending.Logic.React Mlabs.Lending.Logic.State Mlabs.Lending.Logic.Types + Mlabs.Nft.Logic.React + Mlabs.Nft.Logic.State + Mlabs.Nft.Logic.Types default-extensions: BangPatterns ExplicitForAll FlexibleContexts diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index a2914d0e8..366e78771 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -86,7 +86,7 @@ isNonNegative msg val | otherwise = throwError $ msg <> " should be non-negative" {-# INLINABLE isPositive #-} -isPositive :: String -> Integer -> St () +isPositive :: (Applicative m, MonadError String m) => String -> Integer -> m () isPositive msg val | val > 0 = pure () | otherwise = throwError $ msg <> " should be positive" @@ -127,7 +127,7 @@ aToken coin = do {-# INLINABLE guardError #-} -- | Execute further if condition is True or throw error with -- given error message. -guardError :: Error -> Bool -> St () +guardError :: (Applicative m, MonadError Error m) => Error -> Bool -> m () guardError msg isTrue | isTrue = pure () | otherwise = throwError msg diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs new file mode 100644 index 000000000..e73a522c3 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -0,0 +1,53 @@ +-- |Transition function for NFTs +module Mlabs.Nft.Logic.React where + +import Control.Monad.State.Strict (modify', gets) + +import PlutusTx.Prelude + +import Mlabs.Lending.Logic.Emulator.Blockchain +import Mlabs.Lending.Logic.Types (adaCoin) +import Mlabs.Nft.Logic.State +import Mlabs.Nft.Logic.Types + +{-# INLINABLE react #-} +react :: Act -> St [Resp] +react inp = do + checkInputs inp + case inp of + Buy uid price newPrice -> buyAct uid price newPrice + SetPrice uid price -> setPrice uid price + where + buyAct uid price newPrice = do + isRightPrice price + authorShare <- getAuthorShare price + let total = authorShare + price + author <- gets nft'author + owner <- gets nft'owner + updateNftOnBuy + pure + [ Move uid adaCoin (negate total) + , Move owner adaCoin price + , Move author adaCoin authorShare + ] + where + updateNftOnBuy = + modify' $ \st -> st + { nft'owner = uid + , nft'price = newPrice + } + + setPrice uid price = do + isOwner uid + modify' $ \st -> st { nft'price = price } + pure [] + +{-# INLINABLE checkInputs #-} +checkInputs :: Act -> St () +checkInputs = \case + Buy _uid price newPrice -> do + isPositive "Buy price" price + mapM_ (isPositive "New price") newPrice + + SetPrice _uid price -> mapM_ (isPositive "Set price") price + diff --git a/mlabs/src/Mlabs/Nft/Logic/State.hs b/mlabs/src/Mlabs/Nft/Logic/State.hs new file mode 100644 index 000000000..98ef69593 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Logic/State.hs @@ -0,0 +1,67 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | State transitions for Lending app +module Mlabs.Nft.Logic.State( + St + , Error + , isOwner + , isRightPrice + , getAuthorShare + , isPositive +) where + +import qualified PlutusTx.Ratio as R +import qualified PlutusTx.Numeric as N +import PlutusTx.Prelude +import PlutusTx.AssocMap (Map) +import qualified PlutusTx.AssocMap as M + +import Control.Monad.Except hiding (Functor(..), mapM) +import Control.Monad.State.Strict hiding (Functor(..), mapM) + +import Mlabs.Lending.Logic.State (guardError, isPositive) +import Mlabs.Lending.Logic.Types (UserId(..)) +import Mlabs.Nft.Logic.Types + +-- | Type for errors +type Error = String + +-- | State update of lending pool +type St = StateT Nft (Either Error) + +instance Functor St where + {-# INLINABLE fmap #-} + fmap f (StateT a) = StateT $ fmap (\(v, st) -> (f v, st)) . a + +instance Applicative St where + {-# INLINABLE pure #-} + pure a = StateT (\st -> Right (a, st)) + + {-# INLINABLE (<*>) #-} + (StateT f) <*> (StateT a) = StateT $ \st -> case f st of + Left err -> Left err + Right (f1, st1) -> fmap (\(a1, st2) -> (f1 a1, st2)) $ a st1 + +----------------------------------------------------------- +-- common functions + +{-# INLINABLE isOwner #-} +isOwner :: UserId -> St () +isOwner uid = do + owner <- gets nft'owner + guardError "Not an owner" $ uid == owner + +{-# INLINABLE isRightPrice #-} +isRightPrice :: Integer -> St () +isRightPrice inputPrice = do + cond <- maybe False (inputPrice >= ) <$> gets nft'price + guardError "Price not enough" cond + + +{-# INLINABLE getAuthorShare #-} +getAuthorShare :: Integer -> St Integer +getAuthorShare price = do + share <- gets nft'share + pure $ R.round $ R.fromInteger price * share + diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs new file mode 100644 index 000000000..ca60c57a2 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -0,0 +1,43 @@ +-- | Datatypes for NFT state machine. +module Mlabs.Nft.Logic.Types where + +import Data.Aeson (FromJSON, ToJSON) + +import qualified Prelude as Hask +import qualified PlutusTx as PlutusTx +import PlutusTx.Prelude +import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) +import GHC.Generics + +import Mlabs.Lending.Logic.Types (UserId(..)) + +-- | Data for NFTs +data Nft = Nft + { nft'id :: TokenName -- ^ token name, unique identifier for NFT + , nft'data :: ByteString -- ^ data (media, audio, photo, etc) + , nft'share :: Rational -- ^ share for the author on each sell + , nft'author :: UserId -- ^ author + , nft'owner :: UserId -- ^ current owner + , nft'price :: Maybe Integer -- ^ price in ada, if it's nothing then nobody can buy + } + deriving (Show, Generic) + +-- | Acts with NFTs +data Act + = Buy + { act'userId :: UserId + , act'price :: Integer + , act'newPrice :: Maybe Integer + } + | SetPrice + { act'userId :: UserId + , act'newPrice :: Maybe Integer + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON) + +-------------------------------------------------------------------------- +-- boiler plate instances + +PlutusTx.unstableMakeIsData ''Nft + From dd40db47c6aa0d1560c9542b691a4bf9f9ccaea6 Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 20 May 2021 17:05:47 +0300 Subject: [PATCH 39/81] Factor out State code --- mlabs/mlabs-plutus-use-cases.cabal | 2 + mlabs/src/Mlabs/Control/Check.hs | 37 +++++++++++++ mlabs/src/Mlabs/Control/Monad/State.hs | 41 ++++++++++++++ .../Lending/Logic/Emulator/Blockchain.hs | 2 +- mlabs/src/Mlabs/Lending/Logic/React.hs | 1 + mlabs/src/Mlabs/Lending/Logic/State.hs | 53 ++----------------- mlabs/src/Mlabs/Nft/Logic/React.hs | 3 +- mlabs/src/Mlabs/Nft/Logic/State.hs | 37 +++---------- mlabs/src/Mlabs/Nft/Logic/Types.hs | 6 ++- 9 files changed, 99 insertions(+), 83 deletions(-) create mode 100644 mlabs/src/Mlabs/Control/Check.hs create mode 100644 mlabs/src/Mlabs/Control/Monad/State.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 291dfb511..1942800e8 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -43,6 +43,8 @@ library default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: + Mlabs.Control.Check + Mlabs.Control.Monad.State Mlabs.Data.AssocMap Mlabs.Data.List Mlabs.Data.Ord diff --git a/mlabs/src/Mlabs/Control/Check.hs b/mlabs/src/Mlabs/Control/Check.hs new file mode 100644 index 000000000..18c75ec3c --- /dev/null +++ b/mlabs/src/Mlabs/Control/Check.hs @@ -0,0 +1,37 @@ +-- | Common input check functions +module Mlabs.Control.Check( + isNonNegative + , isPositive + , isPositiveRational + , isUnitRange +) where + +import Control.Monad.Except (MonadError(..)) + +import PlutusTx.Prelude +import qualified PlutusTx.Ratio as R + +{-# INLINABLE isNonNegative #-} +isNonNegative :: (Applicative m, MonadError String m) => String -> Integer -> m () +isNonNegative msg val + | val >= 0 = pure () + | otherwise = throwError $ msg <> " should be non-negative" + +{-# INLINABLE isPositive #-} +isPositive :: (Applicative m, MonadError String m) => String -> Integer -> m () +isPositive msg val + | val > 0 = pure () + | otherwise = throwError $ msg <> " should be positive" + +{-# INLINABLE isPositiveRational #-} +isPositiveRational :: (Applicative m, MonadError String m) => String -> Rational -> m () +isPositiveRational msg val + | val > R.fromInteger 0 = pure () + | otherwise = throwError $ msg <> " should be positive" + +{-# INLINABLE isUnitRange #-} +isUnitRange :: (Applicative m, MonadError String m) => String -> Rational -> m () +isUnitRange msg val + | val >= R.fromInteger 0 && val <= R.fromInteger 1 = pure () + | otherwise = throwError $ msg <> " should have unit range [0, 1]" + diff --git a/mlabs/src/Mlabs/Control/Monad/State.hs b/mlabs/src/Mlabs/Control/Monad/State.hs new file mode 100644 index 000000000..c4bdd2739 --- /dev/null +++ b/mlabs/src/Mlabs/Control/Monad/State.hs @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Common plutus instances for StateT +module Mlabs.Control.Monad.State( + PlutusState + , MonadError(..) + , MonadState(..) + , runStateT + , gets + , guardError +) where + +import PlutusTx.Prelude + +import Control.Monad.Except hiding (Functor(..)) +import Control.Monad.State.Strict hiding (Functor(..)) + +-- | State update of lending pool +type PlutusState st = StateT st (Either String) + +instance Functor (PlutusState st) where + {-# INLINABLE fmap #-} + fmap f (StateT a) = StateT $ fmap (\(v, st) -> (f v, st)) . a + +instance Applicative (PlutusState st) where + {-# INLINABLE pure #-} + pure a = StateT (\st -> Right (a, st)) + + {-# INLINABLE (<*>) #-} + (StateT f) <*> (StateT a) = StateT $ \st -> case f st of + Left err -> Left err + Right (f1, st1) -> fmap (\(a1, st2) -> (f1 a1, st2)) $ a st1 + +------------------------------------------------ + +{-# INLINABLE guardError #-} +-- | Execute further if condition is True or throw error with +-- given error message. +guardError :: (Applicative m, MonadError String m) => String -> Bool -> m () +guardError msg isTrue + | isTrue = pure () + | otherwise = throwError msg diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs b/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs index 1f3d52bda..4b38b2b59 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs @@ -13,7 +13,7 @@ import PlutusTx.Prelude hiding (fromMaybe, maybe) import Data.Maybe import Data.Map.Strict (Map) -import Mlabs.Lending.Logic.Types +import Mlabs.Lending.Logic.Types (Coin, UserId(..)) import qualified Data.Map.Strict as M diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 8d0dce4ad..2b1e3268d 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -21,6 +21,7 @@ import qualified PlutusTx.These as PlutusTx import Control.Monad.Except hiding (Functor(..), mapM) import Control.Monad.State.Strict hiding (Functor(..), mapM) +import Mlabs.Control.Check import Mlabs.Lending.Logic.Emulator.Blockchain import Mlabs.Lending.Logic.InterestRate (addDeposit) import Mlabs.Lending.Logic.State diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 366e78771..3a10c5655 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -1,15 +1,10 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- | State transitions for Lending app module Mlabs.Lending.Logic.State( St , showt , Error - , isNonNegative - , isPositive - , isPositiveRational - , isUnitRange , isAsset , aToken , updateReserveState @@ -58,50 +53,16 @@ import Control.Monad.State.Strict hiding (Functor(..), mapM) import qualified Mlabs.Lending.Logic.InterestRate as IR import Mlabs.Lending.Logic.Types +import Mlabs.Control.Monad.State + -- | Type for errors type Error = String -- | State update of lending pool -type St = StateT LendingPool (Either Error) - -instance Functor St where - {-# INLINABLE fmap #-} - fmap f (StateT a) = StateT $ fmap (\(v, st) -> (f v, st)) . a - -instance Applicative St where - {-# INLINABLE pure #-} - pure a = StateT (\st -> Right (a, st)) - - {-# INLINABLE (<*>) #-} - (StateT f) <*> (StateT a) = StateT $ \st -> case f st of - Left err -> Left err - Right (f1, st1) -> fmap (\(a1, st2) -> (f1 a1, st2)) $ a st1 +type St = PlutusState LendingPool ---------------------------------------------------- -- common functions -{-# INLINABLE isNonNegative #-} -isNonNegative :: String -> Integer -> St () -isNonNegative msg val - | val >= 0 = pure () - | otherwise = throwError $ msg <> " should be non-negative" - -{-# INLINABLE isPositive #-} -isPositive :: (Applicative m, MonadError String m) => String -> Integer -> m () -isPositive msg val - | val > 0 = pure () - | otherwise = throwError $ msg <> " should be positive" - -{-# INLINABLE isPositiveRational #-} -isPositiveRational :: String -> Rational -> St () -isPositiveRational msg val - | val > R.fromInteger 0 = pure () - | otherwise = throwError $ msg <> " should be positive" - -{-# INLINABLE isUnitRange #-} -isUnitRange :: String -> Rational -> St () -isUnitRange msg val - | val >= R.fromInteger 0 && val <= R.fromInteger 1 = pure () - | otherwise = throwError $ msg <> " should have unit range [0, 1]" {-# INLINABLE isAsset #-} isAsset :: Coin -> St () @@ -124,14 +85,6 @@ aToken coin = do where err = throwError "Coin not supported" -{-# INLINABLE guardError #-} --- | Execute further if condition is True or throw error with --- given error message. -guardError :: (Applicative m, MonadError Error m) => Error -> Bool -> m () -guardError msg isTrue - | isTrue = pure () - | otherwise = throwError msg - {-# INLINABLE getsWallet #-} -- | Read field from the internal wallet for user and on asset. -- If there is no wallet empty wallet is allocated. diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs index e73a522c3..10fe27257 100644 --- a/mlabs/src/Mlabs/Nft/Logic/React.hs +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -5,6 +5,7 @@ import Control.Monad.State.Strict (modify', gets) import PlutusTx.Prelude +import Mlabs.Control.Check import Mlabs.Lending.Logic.Emulator.Blockchain import Mlabs.Lending.Logic.Types (adaCoin) import Mlabs.Nft.Logic.State @@ -45,7 +46,7 @@ react inp = do {-# INLINABLE checkInputs #-} checkInputs :: Act -> St () checkInputs = \case - Buy _uid price newPrice -> do + Buy _uid price newPrice -> do isPositive "Buy price" price mapM_ (isPositive "New price") newPrice diff --git a/mlabs/src/Mlabs/Nft/Logic/State.hs b/mlabs/src/Mlabs/Nft/Logic/State.hs index 98ef69593..0e00131a7 100644 --- a/mlabs/src/Mlabs/Nft/Logic/State.hs +++ b/mlabs/src/Mlabs/Nft/Logic/State.hs @@ -4,62 +4,41 @@ -- | State transitions for Lending app module Mlabs.Nft.Logic.State( St - , Error , isOwner , isRightPrice , getAuthorShare - , isPositive ) where import qualified PlutusTx.Ratio as R -import qualified PlutusTx.Numeric as N import PlutusTx.Prelude -import PlutusTx.AssocMap (Map) -import qualified PlutusTx.AssocMap as M -import Control.Monad.Except hiding (Functor(..), mapM) -import Control.Monad.State.Strict hiding (Functor(..), mapM) +import Mlabs.Control.Monad.State -import Mlabs.Lending.Logic.State (guardError, isPositive) -import Mlabs.Lending.Logic.Types (UserId(..)) import Mlabs.Nft.Logic.Types - --- | Type for errors -type Error = String +import Mlabs.Lending.Logic.Types -- | State update of lending pool -type St = StateT Nft (Either Error) - -instance Functor St where - {-# INLINABLE fmap #-} - fmap f (StateT a) = StateT $ fmap (\(v, st) -> (f v, st)) . a - -instance Applicative St where - {-# INLINABLE pure #-} - pure a = StateT (\st -> Right (a, st)) - - {-# INLINABLE (<*>) #-} - (StateT f) <*> (StateT a) = StateT $ \st -> case f st of - Left err -> Left err - Right (f1, st1) -> fmap (\(a1, st2) -> (f1 a1, st2)) $ a st1 +type St = PlutusState Nft ----------------------------------------------------------- -- common functions {-# INLINABLE isOwner #-} +-- | Check if user is owner of NFT isOwner :: UserId -> St () isOwner uid = do owner <- gets nft'owner guardError "Not an owner" $ uid == owner {-# INLINABLE isRightPrice #-} +-- | Check if price is enough to buy NFT isRightPrice :: Integer -> St () isRightPrice inputPrice = do - cond <- maybe False (inputPrice >= ) <$> gets nft'price - guardError "Price not enough" cond - + isOk <- maybe False (inputPrice >= ) <$> gets nft'price + guardError "Price not enough" isOk {-# INLINABLE getAuthorShare #-} +-- | Get original author's share of the price of NFT getAuthorShare :: Integer -> St Integer getAuthorShare price = do share <- gets nft'share diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index ca60c57a2..9377098f2 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -6,7 +6,7 @@ import Data.Aeson (FromJSON, ToJSON) import qualified Prelude as Hask import qualified PlutusTx as PlutusTx import PlutusTx.Prelude -import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) +import Plutus.V1.Ledger.Value (TokenName(..)) import GHC.Generics import Mlabs.Lending.Logic.Types (UserId(..)) @@ -22,17 +22,19 @@ data Nft = Nft } deriving (Show, Generic) --- | Acts with NFTs +-- | Actions with NFTs data Act = Buy { act'userId :: UserId , act'price :: Integer , act'newPrice :: Maybe Integer } + -- ^ Buy NFT and set new price | SetPrice { act'userId :: UserId , act'newPrice :: Maybe Integer } + -- ^ Set new price for NFT deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) From 10465444831474d58fbc20ff66fcfc4b524d82a6 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 21 May 2021 12:16:56 +0300 Subject: [PATCH 40/81] Implements unit tests for NFT --- mlabs/mlabs-plutus-use-cases.cabal | 14 +- mlabs/src/Mlabs/Control/Monad/State.hs | 2 +- mlabs/src/Mlabs/Emulator/App.hs | 80 +++++++++++ .../Logic => }/Emulator/Blockchain.hs | 4 +- .../{Lending/Logic => }/Emulator/Script.hs | 44 ++---- mlabs/src/Mlabs/Emulator/Types.hs | 44 ++++++ mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 2 +- .../Mlabs/Lending/Logic/{Emulator => }/App.hs | 83 ++++++------ mlabs/src/Mlabs/Lending/Logic/React.hs | 2 +- mlabs/src/Mlabs/Lending/Logic/Types.hs | 25 +--- mlabs/src/Mlabs/Nft/Logic/App.hs | 81 ++++++++++++ mlabs/src/Mlabs/Nft/Logic/React.hs | 12 +- mlabs/src/Mlabs/Nft/Logic/Types.hs | 14 +- mlabs/test/Main.hs | 19 ++- mlabs/test/Test/Lending/Init.hs | 2 +- mlabs/test/Test/Lending/Logic.hs | 33 +---- mlabs/test/Test/Nft/Logic.hs | 125 ++++++++++++++++++ 17 files changed, 445 insertions(+), 141 deletions(-) create mode 100644 mlabs/src/Mlabs/Emulator/App.hs rename mlabs/src/Mlabs/{Lending/Logic => }/Emulator/Blockchain.hs (95%) rename mlabs/src/Mlabs/{Lending/Logic => }/Emulator/Script.hs (53%) create mode 100644 mlabs/src/Mlabs/Emulator/Types.hs rename mlabs/src/Mlabs/Lending/Logic/{Emulator => }/App.hs (58%) create mode 100644 mlabs/src/Mlabs/Nft/Logic/App.hs create mode 100644 mlabs/test/Test/Nft/Logic.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 1942800e8..28b9ac612 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -36,8 +36,11 @@ library , plutus-pab , plutus-use-cases , prettyprinter + , pretty-show , stm , lens + , tasty + , tasty-hunit , text , freer-extras default-language: Haskell2010 @@ -48,16 +51,19 @@ library Mlabs.Data.AssocMap Mlabs.Data.List Mlabs.Data.Ord + Mlabs.Emulator.App + Mlabs.Emulator.Blockchain + Mlabs.Emulator.Script + Mlabs.Emulator.Types Mlabs.Lending.Contract.Forge Mlabs.Lending.Contract.Lendex Mlabs.Lending.Contract.Utils - Mlabs.Lending.Logic.Emulator.App - Mlabs.Lending.Logic.Emulator.Blockchain - Mlabs.Lending.Logic.Emulator.Script + Mlabs.Lending.Logic.App Mlabs.Lending.Logic.InterestRate Mlabs.Lending.Logic.React Mlabs.Lending.Logic.State Mlabs.Lending.Logic.Types + Mlabs.Nft.Logic.App Mlabs.Nft.Logic.React Mlabs.Nft.Logic.State Mlabs.Nft.Logic.Types @@ -132,6 +138,7 @@ Test-suite mlabs-plutus-use-cases-tests , pretty-show , tasty , tasty-hunit + , tasty-expected-failure , text hs-source-dirs: test Main-is: Main.hs @@ -140,6 +147,7 @@ Test-suite mlabs-plutus-use-cases-tests Test.Lending.Init Test.Lending.Logic Test.Lending.Scene + Test.Nft.Logic Test.Utils default-extensions: RecordWildCards diff --git a/mlabs/src/Mlabs/Control/Monad/State.hs b/mlabs/src/Mlabs/Control/Monad/State.hs index c4bdd2739..5b3d57733 100644 --- a/mlabs/src/Mlabs/Control/Monad/State.hs +++ b/mlabs/src/Mlabs/Control/Monad/State.hs @@ -14,7 +14,7 @@ import PlutusTx.Prelude import Control.Monad.Except hiding (Functor(..)) import Control.Monad.State.Strict hiding (Functor(..)) --- | State update of lending pool +-- | State update of plutus contracts type PlutusState st = StateT st (Either String) instance Functor (PlutusState st) where diff --git a/mlabs/src/Mlabs/Emulator/App.hs b/mlabs/src/Mlabs/Emulator/App.hs new file mode 100644 index 000000000..bd1b000ca --- /dev/null +++ b/mlabs/src/Mlabs/Emulator/App.hs @@ -0,0 +1,80 @@ +-- | Lending app emulator +module Mlabs.Emulator.App( + App(..) + , runApp + , lookupAppWallet + , noErrors + , someErrors + , checkWallets +) where + +import Test.Tasty.HUnit +import Text.Show.Pretty + +import PlutusTx.Prelude +import Control.Monad.State.Strict hiding (Functor(..)) + +import Data.List (foldl') + +import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Script +import Mlabs.Emulator.Types + +import Mlabs.Control.Monad.State + +import qualified Data.Map.Strict as M + +-- | Prototype application +data App st act = App + { app'st :: !st -- ^ lending pool + , app'log :: ![(act, st, String)] -- ^ error log + -- ^ it reports on which act and pool state error has happened + , app'wallets :: !BchState -- ^ current state of blockchain + } + +-- | Lookup state of the blockchain-wallet for a given user-id. +lookupAppWallet :: UserId -> App st act -> Maybe BchWallet +lookupAppWallet uid App{..} = case app'wallets of + BchState wals -> M.lookup uid wals + +-- | Runs application with the list of actions. +-- Returns final state of the application. +runApp :: (act -> PlutusState st [Resp]) -> App st act -> Script act -> App st act +runApp react app acts = foldl' go app (runScript acts) + where + -- There are two possible sources of errors: + -- * we can not make transition to state (react produces Left) + -- * the transition produces action on blockchain that leads to negative balances (applyResp produces Left) + go (App lp errs wallets) act = case runStateT (react act) lp of + Right (resp, nextState) -> case foldM (flip applyResp) wallets resp of + Right nextWallets -> App nextState errs nextWallets + Left err -> App lp ((act, lp, err) : errs) wallets + Left err -> App lp ((act, lp, err) : errs) wallets + + +--------------------------------------------------- +-- test functions + +noErrors :: (Show act, Show st) => App st act -> Assertion +noErrors app = case app'log app of + [] -> assertBool "no errors" True + xs -> do + mapM_ printLog xs + assertFailure "There are errors" + where + printLog (act, lp, msg) = do + pPrint act + pPrint lp + print msg + +someErrors :: App st act -> Assertion +someErrors app = assertBool "Script fails" $ not $ null (app'log app) + +-- | Check that we have those wallets after script was run. +checkWallets :: (Show act, Show st) => [(UserId, BchWallet)] -> App st act -> Assertion +checkWallets wals app = mapM_ (uncurry $ hasWallet app) wals + +-- | Checks that application state contains concrete wallet for a given user id. +hasWallet :: App st act -> UserId -> BchWallet -> Assertion +hasWallet app uid wal = lookupAppWallet uid app @=? Just wal + diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs b/mlabs/src/Mlabs/Emulator/Blockchain.hs similarity index 95% rename from mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs rename to mlabs/src/Mlabs/Emulator/Blockchain.hs index 4b38b2b59..dfb9f0a75 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/Blockchain.hs +++ b/mlabs/src/Mlabs/Emulator/Blockchain.hs @@ -1,5 +1,5 @@ -- | Simple emulation ob blockchain state -module Mlabs.Lending.Logic.Emulator.Blockchain( +module Mlabs.Emulator.Blockchain( BchState(..) , BchWallet(..) , defaultBchWallet @@ -13,7 +13,7 @@ import PlutusTx.Prelude hiding (fromMaybe, maybe) import Data.Maybe import Data.Map.Strict (Map) -import Mlabs.Lending.Logic.Types (Coin, UserId(..)) +import Mlabs.Emulator.Types (Coin, UserId(..)) import qualified Data.Map.Strict as M diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs b/mlabs/src/Mlabs/Emulator/Script.hs similarity index 53% rename from mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs rename to mlabs/src/Mlabs/Emulator/Script.hs index 99c8cc394..c9b9ac0d8 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/Script.hs +++ b/mlabs/src/Mlabs/Emulator/Script.hs @@ -1,10 +1,9 @@ -- | Helper for testing logic of lending pool -module Mlabs.Lending.Logic.Emulator.Script( +module Mlabs.Emulator.Script( Script , runScript - , userAct - , priceAct - , governAct + , getCurrentTime + , putAct ) where import Prelude (Semigroup(..), Monoid(..), Applicative(..)) @@ -16,53 +15,36 @@ import Data.Sequence (Seq) import Data.Monoid (Sum(..)) import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..), Functor, Applicative, toList) -import Mlabs.Lending.Logic.Types import qualified Data.Sequence as Seq -- | Collects user actions and allocates timestamps -type Script = ScriptM () +type Script act = ScriptM act () -- | Auto-allocation of timestamps, monadic interface for collection of actions -newtype ScriptM a = Script (State St a) - deriving newtype (Functor, Applicative, Monad, MonadState St) +newtype ScriptM act a = Script (State (St act) a) + deriving newtype (Functor, Applicative, Monad, MonadState (St act)) -- | Script accumulator state. -data St = St - { st'acts :: Seq Act -- ^ acts so far +data St act = St + { st'acts :: Seq act -- ^ acts so far , st'time :: Sum Integer -- ^ current timestamp } -instance Semigroup St where +instance Semigroup (St a) where St a1 t1 <> St a2 t2 = St (a1 <> a2) (t1 <> t2) -instance Monoid St where +instance Monoid (St a) where mempty = St mempty mempty -- | Extract list of acts from the script -runScript :: Script -> [Act] +runScript :: Script act-> [act] runScript (Script actions) = toList $ st'acts $ execState actions (St Seq.empty 0) -getCurrentTime :: ScriptM Integer +getCurrentTime :: ScriptM act Integer getCurrentTime = gets (getSum . st'time) --- | Make user act -userAct :: UserId -> UserAct -> Script -userAct uid act = do - time <- getCurrentTime - putAct $ UserAct time uid act - --- | Make price act -priceAct :: PriceAct -> Script -priceAct arg = do - t <- getCurrentTime - putAct $ PriceAct t arg - --- | Make govern act -governAct :: GovernAct -> Script -governAct arg = putAct $ GovernAct arg - -putAct :: Act -> Script +putAct :: act -> Script act putAct act = modify' (<> St (Seq.singleton act) (Sum 1)) diff --git a/mlabs/src/Mlabs/Emulator/Types.hs b/mlabs/src/Mlabs/Emulator/Types.hs new file mode 100644 index 000000000..117bb8f0c --- /dev/null +++ b/mlabs/src/Mlabs/Emulator/Types.hs @@ -0,0 +1,44 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +module Mlabs.Emulator.Types( + UserId(..) + , Coin + , adaCoin +) where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Prelude as Hask +import PlutusTx.Prelude + +import GHC.Generics +import qualified Plutus.V1.Ledger.Ada as Ada +import Plutus.V1.Ledger.Value (AssetClass(..)) +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) +import qualified PlutusTx as PlutusTx + +-- | Address of the wallet that can hold values of assets +data UserId + = UserId PubKeyHash -- user address + | Self -- addres of the lending platform + deriving stock (Show, Generic, Hask.Eq, Hask.Ord) + deriving anyclass (FromJSON, ToJSON) + +instance Eq UserId where + {-# INLINABLE (==) #-} + Self == Self = True + UserId a == UserId b = a == b + _ == _ = False + +{-# INLINABLE adaCoin #-} +adaCoin :: Coin +adaCoin = AssetClass (Ada.adaSymbol, Ada.adaToken) + +-- | Custom currency +type Coin = AssetClass + +PlutusTx.unstableMakeIsData ''UserId diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 47b90b84f..10b6ccae1 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -43,7 +43,7 @@ import PlutusTx.Prelude hiding (Applicative (..), check, S import qualified PlutusTx.Prelude as PlutusTx -import Mlabs.Lending.Logic.Emulator.Blockchain +import Mlabs.Emulator.Blockchain import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types import qualified Mlabs.Lending.Contract.Forge as Forge diff --git a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs similarity index 58% rename from mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs rename to mlabs/src/Mlabs/Lending/Logic/App.hs index 7a6e204b1..0be290dbf 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Emulator/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -1,58 +1,38 @@ --- | Lending app emulator -module Mlabs.Lending.Logic.Emulator.App( - App(..) - , runApp +-- | Inits logic test suite app emulator +module Mlabs.Lending.Logic.App( + -- * Application + LendingApp + , runLendingApp + , initApp , AppConfig(..) , defaultAppConfig - , lookupAppWallet , toCoin - , module X + -- * Script actions + , Script + , userAct + , priceAct + , governAct ) where import PlutusTx.Prelude -import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) import Plutus.V1.Ledger.Value +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) -import Control.Monad.State.Strict hiding (Functor(..)) - -import Data.List (foldl') - -import Mlabs.Lending.Logic.Emulator.Blockchain -import Mlabs.Lending.Logic.Emulator.Script as X +import Mlabs.Emulator.App +import Mlabs.Emulator.Blockchain +import qualified Mlabs.Emulator.Script as S +import Mlabs.Emulator.Types import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types -import Mlabs.Lending.Logic.State import qualified Data.Map.Strict as M import qualified PlutusTx.AssocMap as AM import qualified PlutusTx.Ratio as R --- | Prototype application -data App = App - { app'pool :: !LendingPool -- ^ lending pool - , app'log :: ![(Act, LendingPool, Error)] -- ^ error log - -- ^ it reports on which act and pool state error has happened - , app'wallets :: !BchState -- ^ current state of blockchain - } - --- | Lookup state of the blockchain-wallet for a given user-id. -lookupAppWallet :: UserId -> App -> Maybe BchWallet -lookupAppWallet uid App{..} = case app'wallets of - BchState wals -> M.lookup uid wals +type LendingApp = App LendingPool Act --- | Runs application with the list of actions. --- Returns final state of the application. -runApp :: AppConfig -> Script -> App -runApp cfg acts = foldl' go (initApp cfg) $ runScript acts - where - -- There are two possible sources of errors: - -- * we can not make transition to state (react produces Left) - -- * the transition produces action on blockchain that leads to negative balances (applyResp produces Left) - go (App lp errs wallets) act = case runStateT (react act) lp of - Right (resp, nextState) -> case foldM (flip applyResp) wallets resp of - Right nextWallets -> App nextState errs nextWallets - Left err -> App lp ((act, lp, err) : errs) wallets - Left err -> App lp ((act, lp, err) : errs) wallets +runLendingApp :: AppConfig -> Script -> LendingApp +runLendingApp cfg acts = runApp react (initApp cfg) acts -- Configuration paprameters for app. data AppConfig = AppConfig @@ -67,9 +47,9 @@ data AppConfig = AppConfig } -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) -initApp :: AppConfig -> App +initApp :: AppConfig -> LendingApp initApp AppConfig{..} = App - { app'pool = LendingPool + { app'st = LendingPool { lp'reserves = (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) , lp'users = AM.empty , lp'currency = appConfig'currencySymbol @@ -109,3 +89,24 @@ defaultAppConfig = AppConfig reserves users curSym toCoin :: ByteString -> Coin toCoin str = AssetClass (currencySymbol str, tokenName str) +---------------------------------------------------------- +-- scripts + +type Script = S.Script Act + +-- | Make user act +userAct :: UserId -> UserAct -> Script +userAct uid act = do + time <- S.getCurrentTime + S.putAct $ UserAct time uid act + +-- | Make price act +priceAct :: PriceAct -> Script +priceAct arg = do + t <- S.getCurrentTime + S.putAct $ PriceAct t arg + +-- | Make govern act +governAct :: GovernAct -> Script +governAct arg = S.putAct $ GovernAct arg + diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 2b1e3268d..b9b2bded7 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -22,7 +22,7 @@ import Control.Monad.Except hiding (Functor(..), mapM) import Control.Monad.State.Strict hiding (Functor(..), mapM) import Mlabs.Control.Check -import Mlabs.Lending.Logic.Emulator.Blockchain +import Mlabs.Emulator.Blockchain import Mlabs.Lending.Logic.InterestRate (addDeposit) import Mlabs.Lending.Logic.State import Mlabs.Lending.Logic.Types diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 9e33f0629..ea5e6340b 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -47,7 +47,6 @@ module Mlabs.Lending.Logic.Types( , Showt(..) ) where - import Data.Aeson (FromJSON, ToJSON) import qualified PlutusTx.Ratio as R @@ -55,28 +54,16 @@ import qualified Prelude as Hask import qualified PlutusTx as PlutusTx import PlutusTx.Prelude import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) -import qualified Plutus.V1.Ledger.Ada as Ada import PlutusTx.AssocMap (Map) import qualified PlutusTx.AssocMap as M import GHC.Generics -import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) + +import Mlabs.Emulator.Types -- | Class that converts to inlinable builtin string class Showt a where showt :: a -> String --- | Address of the wallet that can hold values of assets -data UserId - = UserId PubKeyHash -- user address - | Self -- addres of the lending platform - deriving stock (Show, Generic, Hask.Eq, Hask.Ord) - deriving anyclass (FromJSON, ToJSON) - -instance Eq UserId where - {-# INLINABLE (==) #-} - Self == Self = True - UserId a == UserId b = a == b - _ == _ = False -- | Lending pool is a list of reserves data LendingPool = LendingPool @@ -174,10 +161,6 @@ initLendingPool curSym coinCfgs = reserves = M.fromList $ fmap (\cfg -> (coinCfg'coin cfg, initReserve cfg)) coinCfgs coinMap = M.fromList $ fmap (\(CoinCfg coin _ aToken _ _) -> (aToken, coin)) coinCfgs -{-# INLINABLE adaCoin #-} -adaCoin :: Coin -adaCoin = AssetClass (Ada.adaSymbol, Ada.adaToken) - {-# INLINABLE initReserve #-} -- | Initialise empty reserve with given ratio of its coin to ada initReserve :: CoinCfg -> Reserve @@ -320,9 +303,6 @@ data PriceAct deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) --- | Custom currency -type Coin = AssetClass - {-# INLINABLE toLendingToken #-} toLendingToken :: LendingPool -> Coin -> Maybe Coin toLendingToken LendingPool{..} coin = @@ -368,7 +348,6 @@ PlutusTx.unstableMakeIsData ''ReserveInterest PlutusTx.unstableMakeIsData ''UserAct PlutusTx.unstableMakeIsData ''PriceAct PlutusTx.unstableMakeIsData ''GovernAct -PlutusTx.unstableMakeIsData ''UserId PlutusTx.unstableMakeIsData ''User PlutusTx.unstableMakeIsData ''Wallet PlutusTx.unstableMakeIsData ''Reserve diff --git a/mlabs/src/Mlabs/Nft/Logic/App.hs b/mlabs/src/Mlabs/Nft/Logic/App.hs new file mode 100644 index 000000000..dc395a3c5 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Logic/App.hs @@ -0,0 +1,81 @@ +-- | Application for testing NFT logic. +module Mlabs.Nft.Logic.App( + NftApp + , runNftApp + , AppCfg(..) + , defaultAppCfg + --- * Script + , Script + , buy + , setPrice +) where + +import PlutusTx.Prelude +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) + +import Mlabs.Emulator.App +import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Types +import qualified Mlabs.Emulator.Script as S + +import Mlabs.Nft.Logic.React +import Mlabs.Nft.Logic.Types + +import qualified Data.Map.Strict as M + +-- | NFT test emulator. We use it test the logic. +type NftApp = App Nft Act + +-- | Config for NFT test emulator +data AppCfg = AppCfg + { appCfg'users :: [(UserId, BchWallet)] -- ^ state of blockchain + , appCfg'nftData :: ByteString -- ^ nft content + , appCfg'nftAuthor :: UserId -- ^ author of nft + } + +-- | Run test emulator for NFT app. +runNftApp :: AppCfg -> Script -> NftApp +runNftApp cfg acts = runApp react (initApp cfg) acts + +-- | Initialise NFT application. +initApp :: AppCfg -> NftApp +initApp AppCfg{..} = App + { app'st = initNft appCfg'nftAuthor appCfg'nftData + , app'log = [] + , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appCfg'users + } + +initNft :: UserId -> ByteString -> Nft +initNft author content = Nft + { nft'id = toNftToken content + , nft'data = content + , nft'share = 1 % 10 + , nft'author = author + , nft'owner = author + , nft'price = Nothing + } + +-- | Default application. +-- It allocates three users each of them has 1000 ada coins. +-- The first user is author and the owner of NFT. NFT is locked with no price. +defaultAppCfg :: AppCfg +defaultAppCfg = AppCfg users "mona-lisa" (fst $ users !! 0) + where + userNames = ["1", "2", "3"] + + users = fmap (\userName -> (UserId (PubKeyHash userName), wal (adaCoin, 1000))) userNames + wal cs = BchWallet $ uncurry M.singleton cs + +------------------------------------------------------- +-- script endpoints + +type Script = S.Script Act + +-- | User buys NFTs +buy :: UserId -> Integer -> Maybe Integer -> Script +buy uid price newPrice = S.putAct $ Buy uid price newPrice + +-- | Set price of NFT +setPrice :: UserId -> Maybe Integer -> Script +setPrice uid newPrice = S.putAct $ SetPrice uid newPrice + diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs index 10fe27257..1710c9a82 100644 --- a/mlabs/src/Mlabs/Nft/Logic/React.hs +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -6,7 +6,7 @@ import Control.Monad.State.Strict (modify', gets) import PlutusTx.Prelude import Mlabs.Control.Check -import Mlabs.Lending.Logic.Emulator.Blockchain +import Mlabs.Emulator.Blockchain import Mlabs.Lending.Logic.Types (adaCoin) import Mlabs.Nft.Logic.State import Mlabs.Nft.Logic.Types @@ -17,8 +17,11 @@ react inp = do checkInputs inp case inp of Buy uid price newPrice -> buyAct uid price newPrice - SetPrice uid price -> setPrice uid price + SetPrice uid price -> setPriceAct uid price where + ----------------------------------------------- + -- buy + buyAct uid price newPrice = do isRightPrice price authorShare <- getAuthorShare price @@ -38,7 +41,10 @@ react inp = do , nft'price = newPrice } - setPrice uid price = do + ----------------------------------------------- + -- set price + + setPriceAct uid price = do isOwner uid modify' $ \st -> st { nft'price = price } pure [] diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index 9377098f2..f5e5babf8 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -1,15 +1,19 @@ -- | Datatypes for NFT state machine. -module Mlabs.Nft.Logic.Types where +module Mlabs.Nft.Logic.Types( + Nft(..) + , toNftToken + , Act(..) +) where import Data.Aeson (FromJSON, ToJSON) import qualified Prelude as Hask import qualified PlutusTx as PlutusTx import PlutusTx.Prelude -import Plutus.V1.Ledger.Value (TokenName(..)) +import Plutus.V1.Ledger.Value (TokenName(..), tokenName) import GHC.Generics -import Mlabs.Lending.Logic.Types (UserId(..)) +import Mlabs.Emulator.Types (UserId(..)) -- | Data for NFTs data Nft = Nft @@ -22,6 +26,10 @@ data Nft = Nft } deriving (Show, Generic) +{-# INLINABLE toNftToken #-} +toNftToken :: ByteString -> TokenName +toNftToken = tokenName . sha2_256 + -- | Actions with NFTs data Act = Buy diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index c5d87662e..f34abf994 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -1,13 +1,22 @@ module Main where import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTest) -import qualified Test.Lending.Contract as Contract -import qualified Test.Lending.Logic as Logic +import qualified Test.Lending.Contract as Lending.Contract +import qualified Test.Lending.Logic as Lending.Logic +import qualified Test.Nft.Logic as Nft.Logic main :: IO () -main = defaultMain $ testGroup "Lending" - [ Logic.test - , Contract.test +main = defaultMain $ testGroup "tests" + [ testGroup "NFT" [ Nft.Logic.test] + , testGroup "Lending" [ Lending.Logic.test + , contract Lending.Contract.test ] ] + where + contract + | ignoreContract = ignoreTest + | otherwise = id + + ignoreContract = False diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index 559fca0a1..1fd4627ca 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -24,7 +24,7 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import Mlabs.Lending.Logic.Types (Coin, UserAct(..), UserId(..)) -import qualified Mlabs.Lending.Logic.Emulator.App as L +import qualified Mlabs.Lending.Logic.App as L import qualified Mlabs.Lending.Contract.Lendex as L import qualified Mlabs.Lending.Contract.Forge as Forge diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index bc1d44c3b..6407cf322 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -10,30 +10,15 @@ import Test.Tasty.HUnit import Plutus.V1.Ledger.Value import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) -import Mlabs.Lending.Logic.Emulator.App -import Mlabs.Lending.Logic.Emulator.Blockchain +import Mlabs.Emulator.App +import Mlabs.Emulator.Blockchain +import Mlabs.Lending.Logic.App import Mlabs.Lending.Logic.Types -import Text.Show.Pretty import qualified Data.Map.Strict as M import qualified PlutusTx.Ratio as R -noErrors :: App -> Assertion -noErrors app = case app'log app of - [] -> assertBool "no errors" True - xs -> do - mapM_ printLog xs - assertFailure "There are errors" - where - printLog (act, lp, msg) = do - pPrint act - pPrint lp - print msg - -someErrors :: App -> Assertion -someErrors app = assertBool "Script fails" $ not $ null (app'log app) - -- | Test suite for a logic of lending application test :: TestTree test = testGroup "Logic" @@ -89,20 +74,16 @@ test = testGroup "Logic" w2 = BchWallet $ M.fromList [(coin2, 40), (aCoin2, 50) , (coin1, 20), (adaCoin, 1)] -- | Checks that script runs without errors -testScript :: Script -> App -testScript script = runApp testAppConfig script +testScript :: Script -> LendingApp +testScript script = runLendingApp testAppConfig script -- | Check that we have those wallets after script was run. testWallets :: [(UserId, BchWallet)] -> Script -> Assertion testWallets wals script = do noErrors app - mapM_ (uncurry $ hasWallet app) wals + checkWallets wals app where - app = runApp testAppConfig script - --- | Checks that application state contains concrete wallet for a given user id. -hasWallet :: App -> UserId -> BchWallet -> Assertion -hasWallet app uid wal = lookupAppWallet uid app @=? Just wal + app = runLendingApp testAppConfig script -- | 3 users deposit 50 coins to lending app depositScript :: Script diff --git a/mlabs/test/Test/Nft/Logic.hs b/mlabs/test/Test/Nft/Logic.hs new file mode 100644 index 000000000..5750a5365 --- /dev/null +++ b/mlabs/test/Test/Nft/Logic.hs @@ -0,0 +1,125 @@ +-- | Tests for logic of state transitions for aave prototype +module Test.Nft.Logic( + test +) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Plutus.V1.Ledger.Value +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) + +import Mlabs.Emulator.App +import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Types + +import Mlabs.Nft.Logic.App +import Mlabs.Nft.Logic.Types + +import qualified Data.Map.Strict as M +import qualified PlutusTx.Ratio as R + +-- | Test suite for a logic of lending application +test :: TestTree +test = testGroup "Logic" + [ testCase "Buy" testBuy + , testCase "Buy twice" testBuyTwice + , testCase "Sets price without ownership" testFailToSetPrice + , testCase "Buy locked NFT" testBuyLocked + , testCase "Buy not enough price" testBuyNotEnoughPrice + ] + where + testBuy = testWallets buyWallets buyScript + testFailToSetPrice = testWalletsFail buyWallets failToSetPriceScript + testBuyLocked = testWalletsFail initWallets failToBuyLocked + testBuyNotEnoughPrice = testWalletsFail initWallets failToBuyNotEnoughPrice + testBuyTwice = testWallets buyTwiceWallets buyTwiceScript + + testWallets wals script = do + noErrors app + checkWallets wals app + where + app = runNftApp defaultAppCfg script + + testWalletsFail wals script = do + someErrors app + checkWallets wals app + where + app = runNftApp defaultAppCfg script + +initWallets :: [(UserId, BchWallet)] +initWallets = [(user1, wal), (user2, wal)] + where + wal = BchWallet $ M.fromList [(adaCoin, 1000)] + +---------------------------------------------------------------------- +-- scripts + +-- buy + +buyScript :: Script +buyScript = do + setPrice user1 (Just 100) + buy user2 100 Nothing + setPrice user2 (Just 500) + +-- * User 1 sets the price to 100 +-- * User 2 buys for 100 and becomes owner +-- * User 1 receives 110 (100 + 10% as author) +buyWallets :: [(UserId, BchWallet)] +buyWallets = [(user1, w1), (user2, w2)] + where + w1 = BchWallet $ M.fromList [(adaCoin, 1110)] + w2 = BchWallet $ M.fromList [(adaCoin, 890)] + +-- buy twice + +-- | +-- * User 2 buys from user 1 +-- * User 3 buys from user 2 +buyTwiceScript :: Script +buyTwiceScript = do + buyScript + buy user3 500 (Just 1000) + +buyTwiceWallets :: [(UserId, BchWallet)] +buyTwiceWallets = [(user1, w1), (user2, w2), (user3, w3)] + where + w1 = BchWallet $ M.fromList [(adaCoin, 1160)] -- 1000 + 100 + 10 + 50 + w2 = BchWallet $ M.fromList [(adaCoin, 1390)] -- 1000 - 100 - 10 + 500 + w3 = BchWallet $ M.fromList [(adaCoin, 450)] -- 1000 - 500 - 50 + +-- fail to set price + +-- | User 1 tries to set price after user 2 owned the NFT. +-- It should fail. +failToSetPriceScript :: Script +failToSetPriceScript = do + buyScript + setPrice user1 (Just 200) + +-- fail to buy locked + +-- | User 2 tries to buy NFT which is locked (no price is set) +failToBuyLocked :: Script +failToBuyLocked = do + buy user2 1000 Nothing + +-- fail to buy with not enough money + +-- | User 2 tries to buy open NFT with not enough money +failToBuyNotEnoughPrice :: Script +failToBuyNotEnoughPrice = do + setPrice user1 (Just 100) + buy user2 10 Nothing + + +---------------------------------------------------------------------- +-- constants + +-- users +user1, user2, user3 :: UserId +user1 = UserId $ PubKeyHash "1" +user2 = UserId $ PubKeyHash "2" +user3 = UserId $ PubKeyHash "3" + From 46fd92b75ebba9867b2ac3ba02332be925d18730 Mon Sep 17 00:00:00 2001 From: Ben Hart Date: Fri, 21 May 2021 16:38:49 -0400 Subject: [PATCH 41/81] broken demo not compiling --- mlabs/demo/Main.hs | 147 +++++++++++++++++++++++++ mlabs/mlabs-plutus-use-cases.cabal | 64 ++++++++--- mlabs/src/Mlabs/Lending/Logic/Types.hs | 6 + 3 files changed, 200 insertions(+), 17 deletions(-) create mode 100644 mlabs/demo/Main.hs diff --git a/mlabs/demo/Main.hs b/mlabs/demo/Main.hs new file mode 100644 index 000000000..4fc116bfd --- /dev/null +++ b/mlabs/demo/Main.hs @@ -0,0 +1,147 @@ +{-# OPTIONS_GHC -Wno-missing-import-lists #-} + +module Main (main) where + +-------------------------------------------------------------------------------- + +import GHC.Generics +import Prelude + +-------------------------------------------------------------------------------- + +import Control.Monad (forM, forM_, void, when) +import Control.Monad.Freer (Eff, Member, interpret, reinterpret, type (~>)) +import Control.Monad.Freer.Error (Error, throwError) +import Control.Monad.Freer.Extras.Log (LogMsg, logDebug) +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (FromJSON, Result (..), ToJSON, encode, fromJSON) +import Data.Bifunctor (Bifunctor (first)) +import Data.Default.Class +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Row (type Empty, type (.\\)) +import Data.Semigroup qualified as Semigroup +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) + +-------------------------------------------------------------------------------- + +import Cardano.Prelude qualified as Cardano +import Cardano.Wallet.Types qualified (WalletInfo (..)) +import Control.Concurrent.Availability qualified as Availability +import Plutus.Contract qualified as Contract +import Plutus.Contract.Effects.ExposeEndpoint qualified as Cardano +import Plutus.Contract.Resumable (Response) +import Plutus.Contract.Schema (Event, Handlers, Input, Output) +import Plutus.Contract.State (Contract, ContractRequest (..), ContractResponse (..)) +import Plutus.Contract.State qualified as Contract +import Plutus.PAB.Core qualified as PAB +import Plutus.PAB.Core.ContractInstance.STM qualified as Cardano +import Plutus.PAB.Effects.Contract (ContractEffect (..), PABContract (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..)) +import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin +import Plutus.PAB.Events.Contract (ContractPABRequest) +import Plutus.PAB.Events.Contract qualified as Contract +import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse) +import Plutus.PAB.Events.ContractInstanceState qualified as Contract +import Plutus.PAB.Monitoring.PABLogMsg (ContractEffectMsg (..), PABMultiAgentMsg (..)) +import Plutus.PAB.Simulator (Simulation, SimulatorContractHandler, SimulatorEffectHandlers) +import Plutus.PAB.Simulator qualified as Simulator +import Plutus.PAB.Types (PABError (..), WebserverConfig (..)) +import Plutus.PAB.Webserver.Server qualified as PAB +import Plutus.V1.Ledger.Ada qualified as Ada +import Plutus.V1.Ledger.Crypto qualified as Ledger +import Plutus.V1.Ledger.Slot qualified as Ledger (Slot (..)) +import Plutus.V1.Ledger.Value qualified as Ledger +import Plutus.V1.Ledger.Value qualified as Value +import PlutusTx.Prelude qualified as PlutusTx +import PlutusTx.Prelude ((%)) +import Wallet.Emulator.Types (Wallet (..), walletPubKey) +import Wallet.Emulator.Wallet qualified as Wallet + +-------------------------------------------------------------------------------- + +import qualified Mlabs.Lending.Contract.Lendex as Lendex +import qualified Mlabs.Lending.Logic.Types as Lendex +import Mlabs.Lending.Logic.Types (Coin, UserAct(..), UserId(..)) +-------------------------------------------------------------------------------- + + +main :: IO () +main = void $ + Simulator.runSimulationWith handlers $ do + shutdown <- PAB.startServerDebug + + cidInit <- Simulator.activateContract (Wallet 1) Init + + -- The initial spend is enough to identify the entire market, provided the initial params are also clear. + -- TODO: get pool info here. + _ <- flip Simulator.waitForState cidInit $ \json -> case fromJSON json of + Success (Just (Semigroup.Last mkt)) -> Just mkt + _ -> Nothing + + + shutdown + +data AavePAB + +data AaveContracts + = Init + | User Lendex.LendingPool + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty AaveContracts where + pretty = viaShow + +instance PABContract AavePAB where + type ContractDef AavePAB = AaveContracts + type State AavePAB = PartiallyDecodedResponse ContractPABRequest + + serialisableState _ = id + +handleLendexContract :: + + ( Member (Error PABError) effs + , Member (LogMsg (PABMultiAgentMsg (Builtin AaveContracts))) effs + ) => + ContractEffect (Builtin AaveContracts) + ~> Eff effs +handleLendexContract = Builtin.handleBuiltin getSchema getContract + where + getSchema = \case + Init -> Builtin.endpointsToSchemas @Empty + User _ -> Builtin.endpointsToSchemas @Lendex.UserLendexSchema + getContract = \case + Init -> SomeBuiltin (Lendex.startLendex startParams) + User lendex -> SomeBuiltin (Lendex.userAction depositAct) + +handlers :: SimulatorEffectHandlers (Builtin AaveContracts) +handlers = + Simulator.mkSimulatorHandlers @(Builtin AaveContracts) [] $ + interpret handleLendexContract + +startParams :: Lendex.StartParams +startParams = Lendex.StartParams + { sp'coins = [initCoinCfg] + , sp'initValue = initValue -- ^ init value deposited to the lending app + } + +initValue :: Value.Value +initValue = Value.singleton Ada.adaSymbol Ada.adaToken 10000 + -- TODO: figure out how to support multiple currencies + -- note: looks like we'll need a minimal minting contract to get currencies working, otherwise we can support Ada collateral, Ada borrow by removing `collateralNonBorrow uid asset` from the contract. + -- <> Value.Singleton () (Value.tokenName "USDc") + +initCoinCfg = Lendex.CoinCfg + { coinCfg'coin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) + , coinCfg'rate = 1 % 1 + , coinCfg'aToken = Value.tokenName "aAda" + , coinCfg'interestModel = Lendex.defaultInterestModel + , coinCfg'liquidationBonus = 2 % 10 + } + +depositAct = DepositAct + { act'amount = 100 + , act'asset = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) + } +-- -------------------------------------------------------------------------------- diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 7f5bf9510..260447eda 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -86,23 +86,53 @@ library TupleSections executable mlabs-plutus-use-cases - main-is: app/Main.hs - build-depends: base >=4.14 && <4.15 - , aeson - , bytestring - , containers - , playground-common - , plutus-core - , plutus-contract - , plutus-ledger - , plutus-tx - , plutus-tx-plugin - , plutus-pab - , prettyprinter - , lens - , text - , freer-extras - default-language: Haskell2010 + main-is: app/Main.hs + build-depends: base >=4.14 && <4.15 + , aeson + , bytestring + , containers + , playground-common + , plutus-core + , plutus-contract + , plutus-ledger + , plutus-tx + , plutus-tx-plugin + , plutus-pab + , prettyprinter + , lens + , text + , freer-extras + default-language: Haskell2010 + +executable demo + main-is: Main.hs + hs-source-dirs: demo + default-extensions: AllowAmbiguousTypes BlockArguments BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase ExplicitNamespaces FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns ImportQualifiedPost RoleAnnotations + ghc-options: -Wall -Wcompat -Weverything -Wmissing-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-unused-packages -Wno-unsafe -Wno-prepositive-qualified-module -Wno-missing-export-lists -Wno-unused-imports -Werror -Wwarn=redundant-constraints -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fobject-code -fno-strictness -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , base + , bytestring + , cardano-prelude + , containers + , data-default-class + , freer-extras + , freer-simple + , lens + , mlabs-plutus-use-cases + , playground-common + , plutus-contract + , plutus-core + , plutus-ledger + , plutus-ledger-api + , plutus-pab + , plutus-tx + , plutus-tx-plugin + , prettyprinter + , row-types + , text + , vector + default-language: Haskell2010 Test-suite mlabs-plutus-use-cases-tests Type: exitcode-stdio-1.0 diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 9e33f0629..e3548c7a5 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -87,6 +87,7 @@ data LendingPool = LendingPool , lp'healthReport :: !HealthReport -- ^ map of unhealthy borrows } deriving (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Reserve of give coin in the pool. -- It holds all info on individual collaterals and deposits. @@ -99,6 +100,7 @@ data Reserve = Reserve , reserve'interest :: !ReserveInterest -- ^ reserve liquidity params } deriving (Show, Generic) + deriving anyclass (FromJSON, ToJSON) type HealthReport = Map BadBorrow Rational @@ -121,6 +123,7 @@ data CoinRate = CoinRate , coinRate'lastUpdateTime :: !Integer -- ^ last time price was updated } deriving (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Parameters for calculation of interest rates. data ReserveInterest = ReserveInterest @@ -131,6 +134,7 @@ data ReserveInterest = ReserveInterest , ri'lastUpdateTime :: !Integer } deriving (Show, Generic) + deriving anyclass (FromJSON, ToJSON) data InterestModel = InterestModel { im'optimalUtilisation :: !Rational @@ -213,6 +217,7 @@ data User = User , user'health :: !Health } deriving (Show, Generic) + deriving anyclass (FromJSON, ToJSON) -- | Health ratio for user per borrow type Health = Map Coin Rational @@ -236,6 +241,7 @@ data Wallet = Wallet , wallet'scaledBalance :: !Rational -- ^ scaled balance } deriving (Show, Generic) + deriving anyclass (FromJSON, ToJSON) {-# INLINABLE defaultWallet #-} From 2d94a97217f9ecef71617f9d98eaeaafd5b204b0 Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 25 May 2021 15:32:03 +0300 Subject: [PATCH 42/81] Adds bindings to plutus and unit tests --- mlabs/mlabs-plutus-use-cases.cabal | 7 +- mlabs/src/Mlabs/Data/Maybe.hs | 13 ++ mlabs/src/Mlabs/Emulator/Blockchain.hs | 36 ++++ .../Lending => src/Mlabs/Emulator}/Scene.hs | 9 +- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 28 +-- mlabs/src/Mlabs/Lending/Logic/State.hs | 5 + mlabs/src/Mlabs/Nft/Contract/Forge.hs | 37 ++++ mlabs/src/Mlabs/Nft/Contract/Nft.hs | 183 ++++++++++++++++++ mlabs/src/Mlabs/Nft/Logic/App.hs | 16 +- mlabs/src/Mlabs/Nft/Logic/React.hs | 21 +- mlabs/src/Mlabs/Nft/Logic/State.hs | 7 +- mlabs/src/Mlabs/Nft/Logic/Types.hs | 54 ++++-- mlabs/test/Main.hs | 4 +- mlabs/test/Test/Lending/Contract.hs | 3 +- mlabs/test/Test/Nft/Contract.hs | 108 +++++++++++ mlabs/test/Test/Nft/Init.hs | 67 +++++++ mlabs/test/Test/Utils.hs | 1 - 17 files changed, 533 insertions(+), 66 deletions(-) create mode 100644 mlabs/src/Mlabs/Data/Maybe.hs rename mlabs/{test/Test/Lending => src/Mlabs/Emulator}/Scene.hs (93%) create mode 100644 mlabs/src/Mlabs/Nft/Contract/Forge.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract/Nft.hs create mode 100644 mlabs/test/Test/Nft/Contract.hs create mode 100644 mlabs/test/Test/Nft/Init.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 28b9ac612..2ffd32229 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -50,9 +50,11 @@ library Mlabs.Control.Monad.State Mlabs.Data.AssocMap Mlabs.Data.List + Mlabs.Data.Maybe Mlabs.Data.Ord Mlabs.Emulator.App Mlabs.Emulator.Blockchain + Mlabs.Emulator.Scene Mlabs.Emulator.Script Mlabs.Emulator.Types Mlabs.Lending.Contract.Forge @@ -67,6 +69,8 @@ library Mlabs.Nft.Logic.React Mlabs.Nft.Logic.State Mlabs.Nft.Logic.Types + Mlabs.Nft.Contract.Nft + Mlabs.Nft.Contract.Forge default-extensions: BangPatterns ExplicitForAll FlexibleContexts @@ -146,7 +150,8 @@ Test-suite mlabs-plutus-use-cases-tests Test.Lending.Contract Test.Lending.Init Test.Lending.Logic - Test.Lending.Scene + Test.Nft.Contract + Test.Nft.Init Test.Nft.Logic Test.Utils default-extensions: diff --git a/mlabs/src/Mlabs/Data/Maybe.hs b/mlabs/src/Mlabs/Data/Maybe.hs new file mode 100644 index 000000000..787ed73c1 --- /dev/null +++ b/mlabs/src/Mlabs/Data/Maybe.hs @@ -0,0 +1,13 @@ +-- | Missing primitives for Maybe +module Mlabs.Data.Maybe( + mapM_ +) where + +import PlutusTx.Prelude hiding (mapM_) + +{-# INLINABLE mapM_ #-} +mapM_ :: Monad f => (a -> f ()) -> Maybe a -> f () +mapM_ f = \case + Nothing -> return () + Just a -> f a + diff --git a/mlabs/src/Mlabs/Emulator/Blockchain.hs b/mlabs/src/Mlabs/Emulator/Blockchain.hs index dfb9f0a75..1747c7724 100644 --- a/mlabs/src/Mlabs/Emulator/Blockchain.hs +++ b/mlabs/src/Mlabs/Emulator/Blockchain.hs @@ -1,3 +1,8 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- | Simple emulation ob blockchain state module Mlabs.Emulator.Blockchain( BchState(..) @@ -6,16 +11,21 @@ module Mlabs.Emulator.Blockchain( , Resp(..) , applyResp , moveFromTo + , toConstraints + , updateRespValue ) where import qualified Prelude as P import PlutusTx.Prelude hiding (fromMaybe, maybe) +import Plutus.V1.Ledger.Value (assetClassValue, Value) +import Ledger.Constraints import Data.Maybe import Data.Map.Strict (Map) import Mlabs.Emulator.Types (Coin, UserId(..)) import qualified Data.Map.Strict as M +import qualified Plutus.Contract.StateMachine as SM -- | Blockchain state is a set of wallets newtype BchState = BchState (Map UserId BchWallet) @@ -77,3 +87,29 @@ applyResp resp (BchState wallets) = fmap BchState $ case resp of where res = fromMaybe 0 x + amt +--------------------------------------------------------------- + +{-# INLINABLE toConstraints #-} +toConstraints :: Resp -> SM.TxConstraints SM.Void SM.Void +toConstraints = \case + Move addr coin amount | amount > 0 -> case addr of + -- pays to lendex app + Self -> mempty -- we already check this constraint with StateMachine + -- pays to the user + UserId pkh -> mustPayToPubKey pkh (assetClassValue coin amount) + Mint coin amount -> mustForgeValue (assetClassValue coin amount) + Burn coin amount -> mustForgeValue (assetClassValue coin $ negate amount) + _ -> mempty + +{-# INLINABLE updateRespValue #-} +updateRespValue :: [Resp] -> Value -> Value +updateRespValue rs val = foldMap toRespValue rs <> val + +{-# INLINABLE toRespValue #-} +toRespValue :: Resp -> Value +toRespValue = \case + Move Self coin amount -> assetClassValue coin amount + Mint coin amount -> assetClassValue coin amount + Burn coin amount -> assetClassValue coin (negate amount) + _ -> mempty + diff --git a/mlabs/test/Test/Lending/Scene.hs b/mlabs/src/Mlabs/Emulator/Scene.hs similarity index 93% rename from mlabs/test/Test/Lending/Scene.hs rename to mlabs/src/Mlabs/Emulator/Scene.hs index 2a91bea8d..6ec44cf9f 100644 --- a/mlabs/test/Test/Lending/Scene.hs +++ b/mlabs/src/Mlabs/Emulator/Scene.hs @@ -1,5 +1,5 @@ -- | Set of balances for tests -module Test.Lending.Scene( +module Mlabs.Emulator.Scene( Scene(..) , owns , appOwns @@ -8,6 +8,8 @@ module Test.Lending.Scene( , coinDiff ) where +import Prelude + import Control.Applicative (Alternative(..)) import Data.Map (Map) @@ -17,8 +19,7 @@ import Plutus.Contract.Test hiding (tx) import Mlabs.Lending.Logic.Types (Coin) import qualified Plutus.V1.Ledger.Value as Value import qualified Data.Map as M - -import Test.Utils +import qualified Data.List as L -- | Scene is users with balances and value that is owned by application script. -- It can be built with Monoid instance from parts with handy functions: @@ -64,3 +65,5 @@ checkScene Scene{..} = withAddressCheck $ coinDiff :: [(Coin, Integer)] -> Value coinDiff = foldMap (uncurry Value.assetClassValue) +concatPredicates :: [TracePredicate] -> TracePredicate +concatPredicates = L.foldl1' (.&&.) diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 10b6ccae1..00730b4ca 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -105,8 +105,8 @@ transition :: transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of Left _err -> Nothing Right (resps, newData) -> Just ( foldMap toConstraints resps - , SM.State { stateData=newData - , stateValue= updateLendexValue resps oldValue }) + , SM.State { stateData = newData + , stateValue = updateRespValue resps oldValue }) ----------------------------------------------------------------------- -- endpoints and schemas @@ -197,30 +197,6 @@ governEndpoints = startLendex' >> forever governAction' --------------------------------------------------------- -{-# INLINABLE toConstraints #-} -toConstraints :: Resp -> TxConstraints SM.Void SM.Void -toConstraints = \case - Move addr coin amount | amount > 0 -> case addr of - -- pays to lendex app - Self -> PlutusTx.mempty -- we already check this constraint with StateMachine - -- pays to the user - UserId pkh -> mustPayToPubKey pkh (assetClassValue coin amount) - Mint coin amount -> mustForgeValue (assetClassValue coin amount) - Burn coin amount -> mustForgeValue (assetClassValue coin $ negate amount) - _ -> PlutusTx.mempty - -{-# INLINABLE updateLendexValue #-} -updateLendexValue :: [Resp] -> Value -> Value -updateLendexValue rs val = foldMap toLendexValue rs PlutusTx.<> val - -{-# INLINABLE toLendexValue #-} -toLendexValue :: Resp -> Value -toLendexValue = \case - Move Self coin amount -> assetClassValue coin amount - Mint coin amount -> assetClassValue coin amount - Burn coin amount -> assetClassValue coin (negate amount) - _ -> PlutusTx.mempty - --------------------------------------------------------- -- call endpoints (for debug and testing) diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 3a10c5655..3160f0cf8 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -1,5 +1,10 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- | State transitions for Lending app module Mlabs.Lending.Logic.State( St diff --git a/mlabs/src/Mlabs/Nft/Contract/Forge.hs b/mlabs/src/Mlabs/Nft/Contract/Forge.hs new file mode 100644 index 000000000..d54d24def --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/Forge.hs @@ -0,0 +1,37 @@ +-- | Validation of forge for NFTs +module Mlabs.Nft.Contract.Forge( + currencyPolicy + , currencySymbol +) where + +import Control.Monad.State.Strict (evalStateT) + +import PlutusTx.Prelude +import Ledger (CurrencySymbol) + +import Ledger.Typed.Scripts (MonetaryPolicy) +import qualified Plutus.V1.Ledger.Value as Value +import qualified Plutus.V1.Ledger.Scripts as Scripts +import qualified Ledger.Typed.Scripts as Scripts +import qualified PlutusTx as PlutusTx +import Plutus.V1.Ledger.Contexts +import Ledger.Constraints + +import Mlabs.Nft.Logic.Types +import Mlabs.Nft.Logic.State + +validate :: NftId -> ScriptContext -> Bool +validate _ _ = True + +------------------------------------------------------------------------------- + +currencyPolicy :: NftId -> MonetaryPolicy +currencyPolicy nid = Scripts.mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \x -> Scripts.wrapMonetaryPolicy (validate x) ||]) + `PlutusTx.applyCode` PlutusTx.liftCode nid + +currencySymbol :: NftId -> CurrencySymbol +currencySymbol nid = scriptCurrencySymbol (currencyPolicy nid) + + + diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs new file mode 100644 index 000000000..2591d027e --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/Nft.hs @@ -0,0 +1,183 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +-- | Plutus bindings for NFT contract +module Mlabs.Nft.Contract.Nft( + machine + , nftAddress + , callUserAct + , callStartNft + , StartParams(..) +) where + +import qualified Prelude as P + +import Control.Monad (forever) +import Control.Monad.State.Strict (runStateT) +import Data.List.Extra (firstJust) + +import Data.Aeson (FromJSON, ToJSON) +import Data.Functor (void) + +import GHC.Generics + +import Plutus.Contract +import qualified Plutus.Contract.StateMachine as SM +import Ledger hiding (singleton) +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Constraints +import qualified PlutusTx as PlutusTx +import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) +import qualified PlutusTx.Prelude as PlutusTx + + +import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Types +import Mlabs.Nft.Logic.React +import Mlabs.Nft.Logic.Types +import qualified Mlabs.Nft.Contract.Forge as Forge +import Mlabs.Lending.Contract.Utils + +import Plutus.Trace.Emulator (EmulatorTrace, callEndpoint, activateContractWallet) +import qualified Wallet.Emulator as Emulator + +import qualified Data.Map as M + +type NftMachine = SM.StateMachine Nft Act +type NftMachineClient = SM.StateMachineClient Nft Act + +{-# INLINABLE machine #-} +machine :: NftId -> NftMachine +machine nftId = (SM.mkStateMachine Nothing (transition nftId) isFinal) + where + isFinal = const False + +{-# INLINABLE mkValidator #-} +mkValidator :: NftId -> Scripts.ValidatorType NftMachine +mkValidator nftId = SM.mkValidator (machine nftId) + +client :: NftId -> NftMachineClient +client nftId = SM.mkStateMachineClient $ SM.StateMachineInstance (machine nftId) (scriptInstance nftId) + +nftValidatorHash :: NftId -> ValidatorHash +nftValidatorHash nftId = Scripts.scriptHash (scriptInstance nftId) + +nftAddress :: NftId -> Address +nftAddress nftId = scriptHashAddress (nftValidatorHash nftId) + +scriptInstance :: NftId -> Scripts.ScriptInstance NftMachine +scriptInstance nftId = Scripts.validator @NftMachine + ($$(PlutusTx.compile [|| mkValidator ||]) + `PlutusTx.applyCode` (PlutusTx.liftCode nftId) + ) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator + +{-# INLINABLE transition #-} +transition :: + NftId + -> SM.State Nft + -> Act + -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State Nft) +transition nftId SM.State{stateData=oldData, stateValue=oldValue} input + | idIsValid = + case runStateT (react input) oldData of + Left _err -> Nothing + Right (resps, newData) -> Just ( foldMap toConstraints resps + , SM.State { stateData = newData + , stateValue = updateRespValue resps oldValue }) + | otherwise = Nothing + where + idIsValid = nftId == nft'id oldData + +----------------------------------------------------------------------- +-- endpoints and schemas + +type NftError = SM.SMContractError + +type NftSchema = + BlockchainActions + .\/ Endpoint "user-action" UserAct + +type NftContract a = Contract () NftSchema NftError a + +findInputStateDatum :: NftId -> NftContract Datum +findInputStateDatum nid = do + utxos <- utxoAt (nftAddress nid) + maybe err P.pure $ firstJust (readDatum . snd) $ M.toList utxos + where + err = throwError $ SM.SMCContractError "Can not find NFT app instance" + +getUserId :: HasBlockchainActions s => Contract () s NftError UserId +getUserId = fmap (UserId . pubKeyHash) ownPubKey + +userAction :: NftId -> UserAct -> NftContract () +userAction nid act = do + pkh <- fmap pubKeyHash ownPubKey + inputDatum <- findInputStateDatum nid + let lookups = monetaryPolicy (Forge.currencyPolicy nid) P.<> + ownPubKeyHash pkh + constraints = mustIncludeDatum inputDatum + t <- SM.mkStep (client nid) (UserAct (UserId pkh) act) + logInfo @String $ "Executes action " P.<> show act + case t of + Left _err -> logError ("Action failed" :: String) + Right SM.StateMachineTransition{smtConstraints=constraints', smtLookups=lookups'} -> do + tx <- submitTxConstraintsWith (lookups P.<> lookups') (constraints P.<> constraints') + -- mapM_ (logInfo @String) (lines $ show $ pretty tx) + awaitTxConfirmed (txId tx) + +-- | Endpoints for user +userEndpoints :: NftId -> NftContract () +userEndpoints nid = forever userAction' + where + userAction' = endpoint @"user-action" >>= (userAction nid) + +data StartParams = StartParams + { sp'content :: ByteString + , sp'share :: Rational + , sp'price :: Maybe Integer + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +type AuthorContract a = Contract () AuthorScheme NftError a + +type AuthorScheme = + BlockchainActions + .\/ Endpoint "start-nft" StartParams + +startNft :: StartParams -> AuthorContract () +startNft StartParams{..} = do + authorId <- getUserId + void $ SM.runInitialise (client nid) (initNft authorId sp'content sp'share sp'price) PlutusTx.mempty + where + nid = toNftId sp'content + +startParamsToNftId :: StartParams -> NftId +startParamsToNftId = toNftId . sp'content + +-- | Endpoints for admin user +authorEndpoints :: AuthorContract () +authorEndpoints = forever startNft' + where + startNft' = endpoint @"start-nft" >>= startNft + +--------------------------------------------------------- +-- call endpoints (for debug and testing) + +-- | Calls user act +callUserAct :: NftId -> Emulator.Wallet -> UserAct -> EmulatorTrace () +callUserAct nid wal act = do + hdl <- activateContractWallet wal (userEndpoints nid) + void $ callEndpoint @"user-action" hdl act + +-- | Calls initialisation of state for Lending pool +callStartNft :: Emulator.Wallet -> StartParams -> EmulatorTrace NftId +callStartNft wal sp = do + hdl <- activateContractWallet wal authorEndpoints + void $ callEndpoint @"start-nft" hdl sp + return nid + where + nid = startParamsToNftId sp + diff --git a/mlabs/src/Mlabs/Nft/Logic/App.hs b/mlabs/src/Mlabs/Nft/Logic/App.hs index dc395a3c5..c3864925d 100644 --- a/mlabs/src/Mlabs/Nft/Logic/App.hs +++ b/mlabs/src/Mlabs/Nft/Logic/App.hs @@ -40,21 +40,11 @@ runNftApp cfg acts = runApp react (initApp cfg) acts -- | Initialise NFT application. initApp :: AppCfg -> NftApp initApp AppCfg{..} = App - { app'st = initNft appCfg'nftAuthor appCfg'nftData + { app'st = initNft appCfg'nftAuthor appCfg'nftData (1 % 10) Nothing , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appCfg'users } -initNft :: UserId -> ByteString -> Nft -initNft author content = Nft - { nft'id = toNftToken content - , nft'data = content - , nft'share = 1 % 10 - , nft'author = author - , nft'owner = author - , nft'price = Nothing - } - -- | Default application. -- It allocates three users each of them has 1000 ada coins. -- The first user is author and the owner of NFT. NFT is locked with no price. @@ -73,9 +63,9 @@ type Script = S.Script Act -- | User buys NFTs buy :: UserId -> Integer -> Maybe Integer -> Script -buy uid price newPrice = S.putAct $ Buy uid price newPrice +buy uid price newPrice = S.putAct $ UserAct uid (Buy price newPrice) -- | Set price of NFT setPrice :: UserId -> Maybe Integer -> Script -setPrice uid newPrice = S.putAct $ SetPrice uid newPrice +setPrice uid newPrice = S.putAct $ UserAct uid (SetPrice newPrice) diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs index 1710c9a82..cce2605ed 100644 --- a/mlabs/src/Mlabs/Nft/Logic/React.hs +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -1,3 +1,10 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- |Transition function for NFTs module Mlabs.Nft.Logic.React where @@ -11,13 +18,15 @@ import Mlabs.Lending.Logic.Types (adaCoin) import Mlabs.Nft.Logic.State import Mlabs.Nft.Logic.Types +import qualified Mlabs.Data.Maybe as Maybe + {-# INLINABLE react #-} react :: Act -> St [Resp] react inp = do checkInputs inp case inp of - Buy uid price newPrice -> buyAct uid price newPrice - SetPrice uid price -> setPriceAct uid price + UserAct uid (Buy price newPrice) -> buyAct uid price newPrice + UserAct uid (SetPrice price) -> setPriceAct uid price where ----------------------------------------------- -- buy @@ -51,10 +60,10 @@ react inp = do {-# INLINABLE checkInputs #-} checkInputs :: Act -> St () -checkInputs = \case - Buy _uid price newPrice -> do +checkInputs (UserAct _uid act) = case act of + Buy price newPrice -> do isPositive "Buy price" price - mapM_ (isPositive "New price") newPrice + Maybe.mapM_ (isPositive "New price") newPrice - SetPrice _uid price -> mapM_ (isPositive "Set price") price + SetPrice price -> Maybe.mapM_ (isPositive "Set price") price diff --git a/mlabs/src/Mlabs/Nft/Logic/State.hs b/mlabs/src/Mlabs/Nft/Logic/State.hs index 0e00131a7..ab3718e88 100644 --- a/mlabs/src/Mlabs/Nft/Logic/State.hs +++ b/mlabs/src/Mlabs/Nft/Logic/State.hs @@ -1,5 +1,10 @@ {-# OPTIONS_GHC -fno-specialize #-} {-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | State transitions for Lending app module Mlabs.Nft.Logic.State( @@ -34,7 +39,7 @@ isOwner uid = do -- | Check if price is enough to buy NFT isRightPrice :: Integer -> St () isRightPrice inputPrice = do - isOk <- maybe False (inputPrice >= ) <$> gets nft'price + isOk <- any (inputPrice >= ) <$> gets nft'price guardError "Price not enough" isOk {-# INLINABLE getAuthorShare #-} diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index f5e5babf8..dc64ee073 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -1,8 +1,18 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- | Datatypes for NFT state machine. module Mlabs.Nft.Logic.Types( Nft(..) - , toNftToken + , NftId(..) + , initNft + , toNftId , Act(..) + , UserAct(..) ) where import Data.Aeson (FromJSON, ToJSON) @@ -17,7 +27,7 @@ import Mlabs.Emulator.Types (UserId(..)) -- | Data for NFTs data Nft = Nft - { nft'id :: TokenName -- ^ token name, unique identifier for NFT + { nft'id :: NftId -- ^ token name, unique identifier for NFT , nft'data :: ByteString -- ^ data (media, audio, photo, etc) , nft'share :: Rational -- ^ share for the author on each sell , nft'author :: UserId -- ^ author @@ -26,21 +36,39 @@ data Nft = Nft } deriving (Show, Generic) -{-# INLINABLE toNftToken #-} -toNftToken :: ByteString -> TokenName -toNftToken = tokenName . sha2_256 +-- | Unique identifier of NFT. +newtype NftId = NftId TokenName + deriving newtype (Show, Eq, PlutusTx.IsData) + +{-# INLINABLE initNft #-} +initNft :: UserId -> ByteString -> Rational -> Maybe Integer -> Nft +initNft author content share mPrice = Nft + { nft'id = toNftId content + , nft'data = content + , nft'share = share + , nft'author = author + , nft'owner = author + , nft'price = mPrice + } + +{-# INLINABLE toNftId #-} +-- | Calculate NFT identifier from it's content (data). +toNftId :: ByteString -> NftId +toNftId = NftId . tokenName . sha2_256 + +data Act = UserAct UserId UserAct + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON) -- | Actions with NFTs -data Act +data UserAct = Buy - { act'userId :: UserId - , act'price :: Integer - , act'newPrice :: Maybe Integer + { act'price :: Integer -- ^ price to buy + , act'newPrice :: Maybe Integer -- ^ new price for NFT (Nothing locks NFT) } -- ^ Buy NFT and set new price | SetPrice - { act'userId :: UserId - , act'newPrice :: Maybe Integer + { act'newPrice :: Maybe Integer -- ^ new price for NFT (Nothing locks NFT) } -- ^ Set new price for NFT deriving stock (Show, Generic, Hask.Eq) @@ -50,4 +78,6 @@ data Act -- boiler plate instances PlutusTx.unstableMakeIsData ''Nft - +PlutusTx.unstableMakeIsData ''UserAct +PlutusTx.unstableMakeIsData ''Act +PlutusTx.makeLift ''NftId diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index f34abf994..cbf0ae64c 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -6,10 +6,12 @@ import Test.Tasty.ExpectedFailure (ignoreTest) import qualified Test.Lending.Contract as Lending.Contract import qualified Test.Lending.Logic as Lending.Logic import qualified Test.Nft.Logic as Nft.Logic +import qualified Test.Nft.Contract as Nft.Contract main :: IO () main = defaultMain $ testGroup "tests" - [ testGroup "NFT" [ Nft.Logic.test] + [ testGroup "NFT" [ Nft.Logic.test + , contract Nft.Contract.test ] , testGroup "Lending" [ Lending.Logic.test , contract Lending.Contract.test ] ] diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index fff946396..00d593b5c 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -11,6 +11,7 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import qualified PlutusTx.Ratio as R +import Mlabs.Emulator.Scene import Mlabs.Lending.Logic.Types ( UserAct(..), InterestRate(..), CoinCfg(..), defaultInterestModel , PriceAct(..), BadBorrow(..)) @@ -20,7 +21,6 @@ import qualified Plutus.V1.Ledger.Value as Value import Test.Utils import Test.Lending.Init -import Test.Lending.Scene test :: TestTree test = testGroup "Contract" @@ -46,7 +46,6 @@ test = testGroup "Contract" , check "Liquidation call real currency" (liquidationCallScene False) (liquidationCallScript False) ] - -------------------------------------------------------------------------------- -- deposit test diff --git a/mlabs/test/Test/Nft/Contract.hs b/mlabs/test/Test/Nft/Contract.hs new file mode 100644 index 000000000..7276378eb --- /dev/null +++ b/mlabs/test/Test/Nft/Contract.hs @@ -0,0 +1,108 @@ +module Test.Nft.Contract( + test +) where + +import Prelude +import Data.Functor (void) + +import Test.Tasty + +import Plutus.Contract.Test hiding (tx) +import qualified Plutus.Trace.Emulator as Trace +import qualified PlutusTx.Ratio as R + +import Mlabs.Emulator.Scene +import Mlabs.Nft.Logic.Types ( UserAct(..)) +import qualified Mlabs.Nft.Contract.Nft as N + +import Test.Utils +import Test.Nft.Init + +test :: TestTree +test = testGroup "Contract" + [ check "Buy" buyScene buyScript + , check "Buy twice" buyTwiceScene buyTwiceScript + , check "Sets price without ownership" buyScene failToSetPriceScript + , check "Buy locked NFT" noChangesScene failToBuyLockedScript + , check "Buy not enough price" noChangesScene failToBuyNotEnoughPriceScript + ] + where + check msg scene = checkPredicateOptions checkOptions msg (checkScene scene) + +-------------------------------------------------------------------------------- +-- buy test + +ownsAda :: Wallet -> Integer -> Scene +ownsAda wal amount = wal `owns` [(adaCoin, amount)] + +noChangesScene :: Scene +noChangesScene = foldMap ( `ownsAda` 0) [w1, w2, w3] + +-- | 3 users deposit 50 coins to lending app. Each of them uses different coin. +buyScript :: Trace.EmulatorTrace () +buyScript = do + void $ N.callStartNft w1 $ N.StartParams + { sp'content = nftContent + , sp'share = 1 R.% 10 + , sp'price = Nothing + } + next + userAct1 $ SetPrice (Just 100) + userAct2 $ Buy 100 Nothing + userAct2 $ SetPrice (Just 500) + +buyScene :: Scene +buyScene = mconcat + [ appAddress $ N.nftAddress nftId + -- , appOwns [(nftCoin, 1)] + , w1 `ownsAda` 110 + , w2 `ownsAda` (-110) + ] + +-- buy twice + +-- | +-- * User 2 buys from user 1 +-- * User 3 buys from user 2 +buyTwiceScript :: Trace.EmulatorTrace () +buyTwiceScript = do + buyScript + userAct3 $ Buy 500 (Just 1000) + +buyTwiceScene :: Scene +buyTwiceScene = buyScene <> buyTwiceChange + where + buyTwiceChange = mconcat + [ w1 `ownsAda` 50 + , w2 `ownsAda` 500 + , w3 `ownsAda` (-550) + ] + + +-------------------------------------------------------------------------------- +-- fail to set price + +-- | User 1 tries to set price after user 2 owned the NFT. +-- It should fail. +failToSetPriceScript :: Trace.EmulatorTrace () +failToSetPriceScript = do + buyScript + userAct1 $ SetPrice (Just 200) + +-------------------------------------------------------------------------------- +-- fail to buy locked + +-- | User 2 tries to buy NFT which is locked (no price is set) +failToBuyLockedScript :: Trace.EmulatorTrace () +failToBuyLockedScript = do + userAct2 $ Buy 1000 Nothing + +-------------------------------------------------------------------------------- +-- fail to buy with not enough money + +-- | User 2 tries to buy open NFT with not enough money +failToBuyNotEnoughPriceScript :: Trace.EmulatorTrace () +failToBuyNotEnoughPriceScript = do + userAct1 $ SetPrice (Just 100) + userAct2 $ Buy 10 Nothing + diff --git a/mlabs/test/Test/Nft/Init.hs b/mlabs/test/Test/Nft/Init.hs new file mode 100644 index 000000000..a8a3606ab --- /dev/null +++ b/mlabs/test/Test/Nft/Init.hs @@ -0,0 +1,67 @@ +-- | Init blockchain state for tests +module Test.Nft.Init( + checkOptions + , w1, w2, w3 + , userAct1, userAct2, userAct3 + , adaCoin + , initialDistribution + , toUserId + , nftId + , nftContent +) where + +import Prelude + +import Control.Lens + +import PlutusTx.Prelude (ByteString) + +import Plutus.V1.Ledger.Value (Value) +import qualified Plutus.V1.Ledger.Ada as Ada +import qualified Plutus.V1.Ledger.Value as Value +import Plutus.V1.Ledger.Contexts (pubKeyHash) +import qualified Data.Map as M + +import Plutus.Contract.Test hiding (tx) +import qualified Plutus.Trace.Emulator as Trace + +import Mlabs.Emulator.Types +import Mlabs.Nft.Logic.Types (UserAct(..), NftId, toNftId) +import qualified Mlabs.Nft.Contract.Nft as N + +import Test.Utils (next) + +checkOptions :: CheckOptions +checkOptions = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution + +-- | Wallets that are used for testing. +w1, w2, w3 :: Wallet +w1 = Wallet 1 +w2 = Wallet 2 +w3 = Wallet 3 + +toUserId :: Wallet -> UserId +toUserId = UserId . pubKeyHash . walletPubKey + +-- | Showrtcuts for user actions +userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () +userAct1 act = N.callUserAct nftId w1 act >> next +userAct2 act = N.callUserAct nftId w2 act >> next +userAct3 act = N.callUserAct nftId w3 act >> next + +nftId :: NftId +nftId = toNftId nftContent + +nftContent :: ByteString +nftContent = "Mona Lisa" + +-- | Initial distribution of wallets for testing +initialDistribution :: M.Map Wallet Value +initialDistribution = M.fromList + [ (w1, val 1000) + , (w2, val 1000) + , (w3, val 1000) + ] + where + val x = Value.singleton Ada.adaSymbol Ada.adaToken x + diff --git a/mlabs/test/Test/Utils.hs b/mlabs/test/Test/Utils.hs index eb203ffd6..dd9b6c898 100644 --- a/mlabs/test/Test/Utils.hs +++ b/mlabs/test/Test/Utils.hs @@ -27,4 +27,3 @@ wait = void . Trace.waitNSlots . fromInteger concatPredicates :: [TracePredicate] -> TracePredicate concatPredicates = L.foldl1' (.&&.) - From ed0e99f54a4c55537b3562741cec25f23df2b06d Mon Sep 17 00:00:00 2001 From: anton-k Date: Thu, 27 May 2021 14:25:32 +0300 Subject: [PATCH 43/81] Monetary policy for NFT --- mlabs/mlabs-plutus-use-cases.cabal | 5 + mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 2 - mlabs/src/Mlabs/Nft/Contract/Forge.hs | 56 ++++++++--- mlabs/src/Mlabs/Nft/Contract/Nft.hs | 92 ++++++++++++++----- mlabs/src/Mlabs/Nft/Logic/App.hs | 11 ++- mlabs/src/Mlabs/Nft/Logic/React.hs | 4 +- mlabs/src/Mlabs/Nft/Logic/Types.hs | 28 ++++-- .../src/Mlabs/Plutus/Contract/StateMachine.hs | 46 ++++++++++ mlabs/test/Test/Nft/Contract.hs | 47 ++++------ mlabs/test/Test/Nft/Init.hs | 54 ++++++++--- mlabs/test/Test/Nft/Logic.hs | 4 +- 11 files changed, 254 insertions(+), 95 deletions(-) create mode 100644 mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 2ffd32229..730f40d9f 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -25,6 +25,7 @@ library , bytestring , containers , extra + , freer-simple , mtl , playground-common , plutus-core @@ -71,6 +72,7 @@ library Mlabs.Nft.Logic.Types Mlabs.Nft.Contract.Nft Mlabs.Nft.Contract.Forge + Mlabs.Plutus.Contract.StateMachine default-extensions: BangPatterns ExplicitForAll FlexibleContexts @@ -125,8 +127,11 @@ Test-suite mlabs-plutus-use-cases-tests Default-Language: Haskell2010 Build-Depends: base >=4.9 && <5 , data-default + , freer-extras + , freer-simple , lens , mlabs-plutus-use-cases + , mtl , containers , playground-common , plutus-core diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 00730b4ca..8b72bc575 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -36,11 +36,9 @@ import Plutus.Contract import qualified Plutus.Contract.StateMachine as SM import Ledger hiding (singleton) import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value (assetClassValue) import Ledger.Constraints import qualified PlutusTx as PlutusTx import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) -import qualified PlutusTx.Prelude as PlutusTx import Mlabs.Emulator.Blockchain diff --git a/mlabs/src/Mlabs/Nft/Contract/Forge.hs b/mlabs/src/Mlabs/Nft/Contract/Forge.hs index d54d24def..fc1ace9ea 100644 --- a/mlabs/src/Mlabs/Nft/Contract/Forge.hs +++ b/mlabs/src/Mlabs/Nft/Contract/Forge.hs @@ -4,10 +4,8 @@ module Mlabs.Nft.Contract.Forge( , currencySymbol ) where -import Control.Monad.State.Strict (evalStateT) - import PlutusTx.Prelude -import Ledger (CurrencySymbol) +import Ledger (CurrencySymbol, Address) import Ledger.Typed.Scripts (MonetaryPolicy) import qualified Plutus.V1.Ledger.Value as Value @@ -15,23 +13,53 @@ import qualified Plutus.V1.Ledger.Scripts as Scripts import qualified Ledger.Typed.Scripts as Scripts import qualified PlutusTx as PlutusTx import Plutus.V1.Ledger.Contexts -import Ledger.Constraints import Mlabs.Nft.Logic.Types -import Mlabs.Nft.Logic.State -validate :: NftId -> ScriptContext -> Bool -validate _ _ = True +{-# INLINABLE validate #-} +-- | Validation of Minting of NFT-token. We guarantee unqiqueness of NFT +-- by make the script depend on spending of concrete TxOutRef in the list of inputs. +-- TxOutRef for the input is specified inside NftId value. +-- +-- Also we check that +-- +-- * user mints token that coressponds to the content of NFT (token name is hash of NFT content) +-- * user spends NFT token to the StateMachine script +-- +-- First argument is an address of NFT state machine script. We use it to check +-- that NFT coin was payed to script after minting. +validate :: Address -> NftId -> ScriptContext -> Bool +validate stateAddr (NftId token oref) ctx = + traceIfFalse "UTXO not consumed" hasUtxo + && traceIfFalse "wrong amount minted" checkMintedAmount + && traceIfFalse "Does not pay to state" paysToState + where + info = scriptContextTxInfo ctx -------------------------------------------------------------------------------- + hasUtxo = any (\inp -> txInInfoOutRef inp == oref) $ txInfoInputs info + + checkMintedAmount = case Value.flattenValue (txInfoForge info) of + [(cur, tn, val)] -> ownCurrencySymbol ctx == cur && token == tn && val == 1 + _ -> False -currencyPolicy :: NftId -> MonetaryPolicy -currencyPolicy nid = Scripts.mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| \x -> Scripts.wrapMonetaryPolicy (validate x) ||]) - `PlutusTx.applyCode` PlutusTx.liftCode nid + paysToState = any hasNftToken $ txInfoOutputs info -currencySymbol :: NftId -> CurrencySymbol -currencySymbol nid = scriptCurrencySymbol (currencyPolicy nid) + hasNftToken TxOut{..} = + txOutAddress == stateAddr + && txOutValue == Value.singleton (ownCurrencySymbol ctx) token 1 + +------------------------------------------------------------------------------- +-- | Monetary policy of NFT +-- First argument is an address of NFT state machine script. +currencyPolicy :: Address -> NftId -> MonetaryPolicy +currencyPolicy stateAddr nid = Scripts.mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \x y -> Scripts.wrapMonetaryPolicy (validate x y) ||]) + `PlutusTx.applyCode` (PlutusTx.liftCode stateAddr) + `PlutusTx.applyCode` (PlutusTx.liftCode nid) +-- | Currency symbol of NFT +-- First argument is an address of NFT state machine script. +currencySymbol :: Address -> NftId -> CurrencySymbol +currencySymbol stateAddr nid = scriptCurrencySymbol (currencyPolicy stateAddr nid) diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs index 2591d027e..0e4c3f879 100644 --- a/mlabs/src/Mlabs/Nft/Contract/Nft.hs +++ b/mlabs/src/Mlabs/Nft/Contract/Nft.hs @@ -16,6 +16,7 @@ import Control.Monad.State.Strict (runStateT) import Data.List.Extra (firstJust) import Data.Aeson (FromJSON, ToJSON) +import Data.Monoid (Last(..)) import Data.Functor (void) import GHC.Generics @@ -27,43 +28,53 @@ import qualified Ledger.Typed.Scripts as Scripts import Ledger.Constraints import qualified PlutusTx as PlutusTx import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) -import qualified PlutusTx.Prelude as PlutusTx - +import qualified Control.Monad.Freer.Error as F import Mlabs.Emulator.Blockchain import Mlabs.Emulator.Types import Mlabs.Nft.Logic.React import Mlabs.Nft.Logic.Types import qualified Mlabs.Nft.Contract.Forge as Forge +import qualified Mlabs.Plutus.Contract.StateMachine as SM import Mlabs.Lending.Contract.Utils -import Plutus.Trace.Emulator (EmulatorTrace, callEndpoint, activateContractWallet) +import Plutus.Trace.Emulator (EmulatorTrace) +import qualified Plutus.Trace.Emulator as Trace import qualified Wallet.Emulator as Emulator import qualified Data.Map as M +import Plutus.V1.Ledger.Value + +-------------------------------------- type NftMachine = SM.StateMachine Nft Act type NftMachineClient = SM.StateMachineClient Nft Act {-# INLINABLE machine #-} +-- | State machine definition machine :: NftId -> NftMachine machine nftId = (SM.mkStateMachine Nothing (transition nftId) isFinal) where isFinal = const False {-# INLINABLE mkValidator #-} +-- | State machine validator mkValidator :: NftId -> Scripts.ValidatorType NftMachine mkValidator nftId = SM.mkValidator (machine nftId) +-- | State machine client client :: NftId -> NftMachineClient client nftId = SM.mkStateMachineClient $ SM.StateMachineInstance (machine nftId) (scriptInstance nftId) +-- | NFT validator hash nftValidatorHash :: NftId -> ValidatorHash nftValidatorHash nftId = Scripts.scriptHash (scriptInstance nftId) +-- | NFT script address nftAddress :: NftId -> Address nftAddress nftId = scriptHashAddress (nftValidatorHash nftId) +-- | NFT script instance scriptInstance :: NftId -> Scripts.ScriptInstance NftMachine scriptInstance nftId = Scripts.validator @NftMachine ($$(PlutusTx.compile [|| mkValidator ||]) @@ -74,6 +85,7 @@ scriptInstance nftId = Scripts.validator @NftMachine wrap = Scripts.wrapValidator {-# INLINABLE transition #-} +-- | State transitions for NFT transition :: NftId -> SM.State Nft @@ -90,17 +102,40 @@ transition nftId SM.State{stateData=oldData, stateValue=oldValue} input where idIsValid = nftId == nft'id oldData +----------------------------------------------------------------------- +-- NFT forge policy + +-- | NFT monetary policy +nftPolicy :: NftId -> MonetaryPolicy +nftPolicy nid = Forge.currencyPolicy (nftAddress nid) nid + +-- | NFT currency symbol +nftSymbol :: NftId -> CurrencySymbol +nftSymbol nid = Forge.currencySymbol (nftAddress nid) nid + +-- | NFT coin (AssetClass) +nftCoin :: NftId -> AssetClass +nftCoin nid = AssetClass (nftSymbol nid, nftId'token nid) + +-- | Single value of NFT coin. We check that there is only one NFT-coin can be minted. +nftValue :: NftId -> Value +nftValue nid = assetClassValue (nftCoin nid) 1 + ----------------------------------------------------------------------- -- endpoints and schemas +-- | NFT errors type NftError = SM.SMContractError +-- | User schema. Owner can set the price and the buyer can try to buy. type NftSchema = BlockchainActions .\/ Endpoint "user-action" UserAct +-- | NFT contract for the user type NftContract a = Contract () NftSchema NftError a +-- | Finds Datum for NFT state machine script. findInputStateDatum :: NftId -> NftContract Datum findInputStateDatum nid = do utxos <- utxoAt (nftAddress nid) @@ -108,14 +143,16 @@ findInputStateDatum nid = do where err = throwError $ SM.SMCContractError "Can not find NFT app instance" -getUserId :: HasBlockchainActions s => Contract () s NftError UserId +-- | Get user id of the wallet owner. +getUserId :: HasBlockchainActions s => Contract w s NftError UserId getUserId = fmap (UserId . pubKeyHash) ownPubKey +-- | User action endpoint userAction :: NftId -> UserAct -> NftContract () userAction nid act = do pkh <- fmap pubKeyHash ownPubKey inputDatum <- findInputStateDatum nid - let lookups = monetaryPolicy (Forge.currencyPolicy nid) P.<> + let lookups = monetaryPolicy (nftPolicy nid) P.<> ownPubKeyHash pkh constraints = mustIncludeDatum inputDatum t <- SM.mkStep (client nid) (UserAct (UserId pkh) act) @@ -133,29 +170,38 @@ userEndpoints nid = forever userAction' where userAction' = endpoint @"user-action" >>= (userAction nid) +-- | Parameters to init NFT data StartParams = StartParams - { sp'content :: ByteString - , sp'share :: Rational - , sp'price :: Maybe Integer + { sp'content :: ByteString -- ^ NFT content + , sp'share :: Rational -- ^ author share [0, 1] on reselling of the NFT + , sp'price :: Maybe Integer -- ^ current price of NFT, if it's nothing then nobody can buy it. } deriving stock (Show, Generic) deriving anyclass (FromJSON, ToJSON) -type AuthorContract a = Contract () AuthorScheme NftError a +-- | Contract for the author of NFT +type AuthorContract a = Contract (Last NftId) AuthorScheme NftError a +-- | Schema for the author of NFT type AuthorScheme = BlockchainActions .\/ Endpoint "start-nft" StartParams +-- | Initialise NFt endpoint. +-- We save NftId to the contract writer. startNft :: StartParams -> AuthorContract () startNft StartParams{..} = do - authorId <- getUserId - void $ SM.runInitialise (client nid) (initNft authorId sp'content sp'share sp'price) PlutusTx.mempty - where - nid = toNftId sp'content - -startParamsToNftId :: StartParams -> NftId -startParamsToNftId = toNftId . sp'content + orefs <- M.keys <$> (utxoAt =<< pubKeyAddress <$> ownPubKey) + case orefs of + [] -> logError @String "No UTXO found" + oref : _ -> do + let nftId = toNftId oref sp'content + val = nftValue nftId + lookups = monetaryPolicy $ nftPolicy nftId + tx = mustForgeValue val + authorId <- getUserId + void $ SM.runInitialiseWith (client nftId) (initNft oref authorId sp'content sp'share sp'price) val lookups tx + tell $ Last $ Just nftId -- | Endpoints for admin user authorEndpoints :: AuthorContract () @@ -169,15 +215,17 @@ authorEndpoints = forever startNft' -- | Calls user act callUserAct :: NftId -> Emulator.Wallet -> UserAct -> EmulatorTrace () callUserAct nid wal act = do - hdl <- activateContractWallet wal (userEndpoints nid) - void $ callEndpoint @"user-action" hdl act + hdl <- Trace.activateContractWallet wal (userEndpoints nid) + void $ Trace.callEndpoint @"user-action" hdl act -- | Calls initialisation of state for Lending pool callStartNft :: Emulator.Wallet -> StartParams -> EmulatorTrace NftId callStartNft wal sp = do - hdl <- activateContractWallet wal authorEndpoints - void $ callEndpoint @"start-nft" hdl sp - return nid + hdl <- Trace.activateContractWallet wal authorEndpoints + void $ Trace.callEndpoint @"start-nft" hdl sp + void $ Trace.waitNSlots 10 + Last nid <- Trace.observableState hdl + maybe err P.pure nid where - nid = startParamsToNftId sp + err = F.throwError $ Trace.GenericError "No NFT started in emulator" diff --git a/mlabs/src/Mlabs/Nft/Logic/App.hs b/mlabs/src/Mlabs/Nft/Logic/App.hs index c3864925d..05ff8f693 100644 --- a/mlabs/src/Mlabs/Nft/Logic/App.hs +++ b/mlabs/src/Mlabs/Nft/Logic/App.hs @@ -12,6 +12,8 @@ module Mlabs.Nft.Logic.App( import PlutusTx.Prelude import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) +import Playground.Contract (TxOutRef(..)) +import Plutus.V1.Ledger.TxId import Mlabs.Emulator.App import Mlabs.Emulator.Blockchain @@ -29,6 +31,7 @@ type NftApp = App Nft Act -- | Config for NFT test emulator data AppCfg = AppCfg { appCfg'users :: [(UserId, BchWallet)] -- ^ state of blockchain + , appCfg'nftInRef :: TxOutRef , appCfg'nftData :: ByteString -- ^ nft content , appCfg'nftAuthor :: UserId -- ^ author of nft } @@ -40,8 +43,8 @@ runNftApp cfg acts = runApp react (initApp cfg) acts -- | Initialise NFT application. initApp :: AppCfg -> NftApp initApp AppCfg{..} = App - { app'st = initNft appCfg'nftAuthor appCfg'nftData (1 % 10) Nothing - , app'log = [] + { app'st = initNft appCfg'nftInRef appCfg'nftAuthor appCfg'nftData (1 % 10) Nothing + , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appCfg'users } @@ -49,8 +52,10 @@ initApp AppCfg{..} = App -- It allocates three users each of them has 1000 ada coins. -- The first user is author and the owner of NFT. NFT is locked with no price. defaultAppCfg :: AppCfg -defaultAppCfg = AppCfg users "mona-lisa" (fst $ users !! 0) +defaultAppCfg = AppCfg users dummyOutRef "mona-lisa" (fst $ users !! 0) where + dummyOutRef = TxOutRef (TxId "") 0 + userNames = ["1", "2", "3"] users = fmap (\userName -> (UserId (PubKeyHash userName), wal (adaCoin, 1000))) userNames diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs index cce2605ed..2ab1d9cf5 100644 --- a/mlabs/src/Mlabs/Nft/Logic/React.hs +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -5,7 +5,7 @@ {-# OPTIONS_GHC -fobject-code #-} {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} --- |Transition function for NFTs +-- | Transition function for NFTs module Mlabs.Nft.Logic.React where import Control.Monad.State.Strict (modify', gets) @@ -21,6 +21,7 @@ import Mlabs.Nft.Logic.Types import qualified Mlabs.Data.Maybe as Maybe {-# INLINABLE react #-} +-- | State transitions for NFT contract logic. react :: Act -> St [Resp] react inp = do checkInputs inp @@ -59,6 +60,7 @@ react inp = do pure [] {-# INLINABLE checkInputs #-} +-- | Check inputs for valid values. checkInputs :: Act -> St () checkInputs (UserAct _uid act) = case act of Buy price newPrice -> do diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index dc64ee073..64ca52c0f 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -22,6 +22,7 @@ import qualified PlutusTx as PlutusTx import PlutusTx.Prelude import Plutus.V1.Ledger.Value (TokenName(..), tokenName) import GHC.Generics +import Playground.Contract (TxOutRef) import Mlabs.Emulator.Types (UserId(..)) @@ -37,13 +38,24 @@ data Nft = Nft deriving (Show, Generic) -- | Unique identifier of NFT. -newtype NftId = NftId TokenName - deriving newtype (Show, Eq, PlutusTx.IsData) +data NftId = NftId + { nftId'token :: TokenName -- ^ token name is identified by content of the NFT (it's hash of it) + , nftId'outRef :: TxOutRef -- ^ TxOutRef that is used for minting of NFT, + -- with it we can guarantee unqiqueness of NFT + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON) + +instance Eq NftId where + {-# INLINABLE (==) #-} + (==) (NftId tok1 oref1) (NftId tok2 oref2) = + tok1 == tok2 && oref1 == oref2 {-# INLINABLE initNft #-} -initNft :: UserId -> ByteString -> Rational -> Maybe Integer -> Nft -initNft author content share mPrice = Nft - { nft'id = toNftId content +-- | Initialise NFT +initNft :: TxOutRef -> UserId -> ByteString -> Rational -> Maybe Integer -> Nft +initNft nftInRef author content share mPrice = Nft + { nft'id = toNftId nftInRef content , nft'data = content , nft'share = share , nft'author = author @@ -53,9 +65,10 @@ initNft author content share mPrice = Nft {-# INLINABLE toNftId #-} -- | Calculate NFT identifier from it's content (data). -toNftId :: ByteString -> NftId -toNftId = NftId . tokenName . sha2_256 +toNftId :: TxOutRef -> ByteString -> NftId +toNftId oref content = NftId (tokenName $ sha2_256 content) oref +-- | Actions with NFTs with UserId. data Act = UserAct UserId UserAct deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) @@ -80,4 +93,5 @@ data UserAct PlutusTx.unstableMakeIsData ''Nft PlutusTx.unstableMakeIsData ''UserAct PlutusTx.unstableMakeIsData ''Act +PlutusTx.unstableMakeIsData ''NftId PlutusTx.makeLift ''NftId diff --git a/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs b/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs new file mode 100644 index 000000000..65d4233fa --- /dev/null +++ b/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE NamedFieldPuns #-} +-- | Missing functions for StateMachine +module Mlabs.Plutus.Contract.StateMachine( + runInitialiseWith +) where + +import Prelude + +import Control.Lens +import Control.Monad.Error.Lens +import Ledger.Constraints (ScriptLookups, mustPayToTheScript) +import qualified Ledger.Constraints.OffChain as Constraints +import qualified Ledger.Typed.Scripts as Scripts +import Plutus.Contract +import qualified Plutus.Contract.StateMachine.OnChain as SM +import qualified PlutusTx as PlutusTx +import Ledger.Value + +import Plutus.Contract.StateMachine + +-- | Initialise a state machine +runInitialiseWith :: + forall w e state schema input. + ( PlutusTx.IsData state + , PlutusTx.IsData input + , HasTxConfirmation schema + , HasWriteTx schema + , AsSMContractError e + ) + => StateMachineClient state input + -- ^ The state machine + -> state + -- ^ The initial state + -> Value + -- ^ The value locked by the contract at the beginning + -> ScriptLookups (StateMachine state input) + -> TxConstraints (Scripts.RedeemerType (StateMachine state input)) (Scripts.DatumType (StateMachine state input)) + -> Contract w schema e state +runInitialiseWith StateMachineClient{scInstance} initialState initialValue customLookups customConstraints = mapError (review _SMContractError) $ do + let StateMachineInstance{validatorInstance, stateMachine} = scInstance + tx = mustPayToTheScript initialState (initialValue <> SM.threadTokenValue stateMachine) <> customConstraints + let lookups = Constraints.scriptInstanceLookups validatorInstance <> customLookups + utx <- either (throwing _ConstraintResolutionError) pure (Constraints.mkTx lookups tx) + submitTxConfirmed utx + pure initialState + diff --git a/mlabs/test/Test/Nft/Contract.hs b/mlabs/test/Test/Nft/Contract.hs index 7276378eb..13c78cd65 100644 --- a/mlabs/test/Test/Nft/Contract.hs +++ b/mlabs/test/Test/Nft/Contract.hs @@ -3,20 +3,14 @@ module Test.Nft.Contract( ) where import Prelude -import Data.Functor (void) - import Test.Tasty +import Test.Nft.Init import Plutus.Contract.Test hiding (tx) -import qualified Plutus.Trace.Emulator as Trace -import qualified PlutusTx.Ratio as R import Mlabs.Emulator.Scene import Mlabs.Nft.Logic.Types ( UserAct(..)) -import qualified Mlabs.Nft.Contract.Nft as N -import Test.Utils -import Test.Nft.Init test :: TestTree test = testGroup "Contract" @@ -27,7 +21,7 @@ test = testGroup "Contract" , check "Buy not enough price" noChangesScene failToBuyNotEnoughPriceScript ] where - check msg scene = checkPredicateOptions checkOptions msg (checkScene scene) + check msg scene script = checkPredicateOptions checkOptions msg (checkScene scene) (runScript script) -------------------------------------------------------------------------------- -- buy test @@ -39,23 +33,15 @@ noChangesScene :: Scene noChangesScene = foldMap ( `ownsAda` 0) [w1, w2, w3] -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. -buyScript :: Trace.EmulatorTrace () +buyScript :: Script buyScript = do - void $ N.callStartNft w1 $ N.StartParams - { sp'content = nftContent - , sp'share = 1 R.% 10 - , sp'price = Nothing - } - next - userAct1 $ SetPrice (Just 100) - userAct2 $ Buy 100 Nothing - userAct2 $ SetPrice (Just 500) + userAct w1 $ SetPrice (Just 100) + userAct w2 $ Buy 100 Nothing + userAct w2 $ SetPrice (Just 500) buyScene :: Scene buyScene = mconcat - [ appAddress $ N.nftAddress nftId - -- , appOwns [(nftCoin, 1)] - , w1 `ownsAda` 110 + [ w1 `ownsAda` 110 , w2 `ownsAda` (-110) ] @@ -64,10 +50,10 @@ buyScene = mconcat -- | -- * User 2 buys from user 1 -- * User 3 buys from user 2 -buyTwiceScript :: Trace.EmulatorTrace () +buyTwiceScript :: Script buyTwiceScript = do buyScript - userAct3 $ Buy 500 (Just 1000) + userAct w3 $ Buy 500 (Just 1000) buyTwiceScene :: Scene buyTwiceScene = buyScene <> buyTwiceChange @@ -78,31 +64,30 @@ buyTwiceScene = buyScene <> buyTwiceChange , w3 `ownsAda` (-550) ] - -------------------------------------------------------------------------------- -- fail to set price -- | User 1 tries to set price after user 2 owned the NFT. -- It should fail. -failToSetPriceScript :: Trace.EmulatorTrace () +failToSetPriceScript :: Script failToSetPriceScript = do buyScript - userAct1 $ SetPrice (Just 200) + userAct w1 $ SetPrice (Just 200) -------------------------------------------------------------------------------- -- fail to buy locked -- | User 2 tries to buy NFT which is locked (no price is set) -failToBuyLockedScript :: Trace.EmulatorTrace () +failToBuyLockedScript :: Script failToBuyLockedScript = do - userAct2 $ Buy 1000 Nothing + userAct w2 $ Buy 1000 Nothing -------------------------------------------------------------------------------- -- fail to buy with not enough money -- | User 2 tries to buy open NFT with not enough money -failToBuyNotEnoughPriceScript :: Trace.EmulatorTrace () +failToBuyNotEnoughPriceScript :: Script failToBuyNotEnoughPriceScript = do - userAct1 $ SetPrice (Just 100) - userAct2 $ Buy 10 Nothing + userAct w1 $ SetPrice (Just 100) + userAct w2 $ Buy 10 Nothing diff --git a/mlabs/test/Test/Nft/Init.hs b/mlabs/test/Test/Nft/Init.hs index a8a3606ab..29e92c911 100644 --- a/mlabs/test/Test/Nft/Init.hs +++ b/mlabs/test/Test/Nft/Init.hs @@ -1,15 +1,19 @@ +{-# LANGUAGE DataKinds #-} -- | Init blockchain state for tests module Test.Nft.Init( - checkOptions + Script + , runScript + , checkOptions , w1, w2, w3 - , userAct1, userAct2, userAct3 + , userAct , adaCoin , initialDistribution , toUserId - , nftId , nftContent ) where +import Control.Monad.Reader + import Prelude import Control.Lens @@ -26,11 +30,22 @@ import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace import Mlabs.Emulator.Types -import Mlabs.Nft.Logic.Types (UserAct(..), NftId, toNftId) +import Mlabs.Nft.Logic.Types (UserAct(..), NftId) import qualified Mlabs.Nft.Contract.Nft as N import Test.Utils (next) +import Control.Monad.Freer +import Plutus.Trace.Effects.RunContract +import Plutus.Trace.Effects.Waiting +import Plutus.Trace.Effects.EmulatorControl +import Plutus.Trace.Effects.EmulatedWalletAPI +import Control.Monad.Freer.Extras.Log +import Control.Monad.Freer.Error +import Plutus.Trace.Emulator + +import qualified PlutusTx.Ratio as R + checkOptions :: CheckOptions checkOptions = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution @@ -43,19 +58,34 @@ w3 = Wallet 3 toUserId :: Wallet -> UserId toUserId = UserId . pubKeyHash . walletPubKey --- | Showrtcuts for user actions -userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () -userAct1 act = N.callUserAct nftId w1 act >> next -userAct2 act = N.callUserAct nftId w2 act >> next -userAct3 act = N.callUserAct nftId w3 act >> next +-- | Helper to run the scripts for NFT-contract +type ScriptM a = ReaderT NftId ( Eff '[RunContract, Waiting, EmulatorControl, EmulatedWalletAPI, LogMsg String, Error EmulatorRuntimeError]) a +type Script = ScriptM () + +-- | Script runner. It inits NFT by user 1 and provides nft id to all sequent +-- endpoint calls. +runScript :: Script -> Trace.EmulatorTrace () +runScript script = do + nftId <- N.callStartNft w1 $ N.StartParams + { sp'content = nftContent + , sp'share = 1 R.% 10 + , sp'price = Nothing + } + next + runReaderT script nftId -nftId :: NftId -nftId = toNftId nftContent +-- | User action call. +userAct :: Wallet -> UserAct -> Script +userAct wal act = do + nftId <- ask + lift $ N.callUserAct nftId wal act >> next +-- | NFT content for testing. nftContent :: ByteString nftContent = "Mona Lisa" --- | Initial distribution of wallets for testing +-- | Initial distribution of wallets for testing. +-- We have 3 users. All of them get 1000 lovelace at the start. initialDistribution :: M.Map Wallet Value initialDistribution = M.fromList [ (w1, val 1000) diff --git a/mlabs/test/Test/Nft/Logic.hs b/mlabs/test/Test/Nft/Logic.hs index 5750a5365..cb070395c 100644 --- a/mlabs/test/Test/Nft/Logic.hs +++ b/mlabs/test/Test/Nft/Logic.hs @@ -6,7 +6,6 @@ module Test.Nft.Logic( import Test.Tasty import Test.Tasty.HUnit -import Plutus.V1.Ledger.Value import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) import Mlabs.Emulator.App @@ -14,10 +13,8 @@ import Mlabs.Emulator.Blockchain import Mlabs.Emulator.Types import Mlabs.Nft.Logic.App -import Mlabs.Nft.Logic.Types import qualified Data.Map.Strict as M -import qualified PlutusTx.Ratio as R -- | Test suite for a logic of lending application test :: TestTree @@ -57,6 +54,7 @@ initWallets = [(user1, wal), (user2, wal)] -- buy +-- | Buy script buyScript :: Script buyScript = do setPrice user1 (Just 100) From 763cf892068acdc5fb476df666223ce48f1baaff Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 28 May 2021 13:28:17 +0300 Subject: [PATCH 44/81] Fix check of user-ids in the input --- mlabs/mlabs-plutus-use-cases.cabal | 1 + mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 11 +++++++++-- mlabs/src/Mlabs/Nft/Contract/Nft.hs | 10 +++++++++- 3 files changed, 19 insertions(+), 3 deletions(-) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 730f40d9f..627de50df 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -44,6 +44,7 @@ library , tasty-hunit , text , freer-extras + , insert-ordered-containers default-language: Haskell2010 hs-source-dirs: src/ exposed-modules: diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 8b72bc575..a924d63de 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -39,7 +39,7 @@ import qualified Ledger.Typed.Scripts as Scripts import Ledger.Constraints import qualified PlutusTx as PlutusTx import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) - +import qualified PlutusTx.Prelude as Plutus import Mlabs.Emulator.Blockchain import Mlabs.Lending.Logic.React @@ -102,9 +102,16 @@ transition :: -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of Left _err -> Nothing - Right (resps, newData) -> Just ( foldMap toConstraints resps + Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints , SM.State { stateData = newData , stateValue = updateRespValue resps oldValue }) + where + -- we check that user indeed signed the transaction with his own key + ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId + + userId = case input of + UserAct _ (UserId uid) _ -> Just uid + _ -> Nothing ----------------------------------------------------------------------- -- endpoints and schemas diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs index 0e4c3f879..940224cf7 100644 --- a/mlabs/src/Mlabs/Nft/Contract/Nft.hs +++ b/mlabs/src/Mlabs/Nft/Contract/Nft.hs @@ -20,6 +20,7 @@ import Data.Monoid (Last(..)) import Data.Functor (void) import GHC.Generics +import qualified PlutusTx.Prelude as Plutus import Plutus.Contract import qualified Plutus.Contract.StateMachine as SM @@ -95,13 +96,20 @@ transition nftId SM.State{stateData=oldData, stateValue=oldValue} input | idIsValid = case runStateT (react input) oldData of Left _err -> Nothing - Right (resps, newData) -> Just ( foldMap toConstraints resps + Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints , SM.State { stateData = newData , stateValue = updateRespValue resps oldValue }) | otherwise = Nothing where idIsValid = nftId == nft'id oldData + -- we check that user indeed signed the transaction with his own key + ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId + + userId = case input of + UserAct (UserId uid) _ -> Just uid + _ -> Nothing + ----------------------------------------------------------------------- -- NFT forge policy From 32f6dceed99cc81c1e56ad47697f85e65805f12b Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 28 May 2021 13:59:46 +0300 Subject: [PATCH 45/81] Implement trusted oracles --- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 14 +++++------ mlabs/src/Mlabs/Lending/Logic/App.hs | 22 ++++++++++-------- mlabs/src/Mlabs/Lending/Logic/React.hs | 20 ++++++++-------- mlabs/src/Mlabs/Lending/Logic/State.hs | 15 ++++++++---- mlabs/src/Mlabs/Lending/Logic/Types.hs | 27 ++++++++++++---------- mlabs/test/Test/Lending/Contract.hs | 7 +++--- mlabs/test/Test/Lending/Logic.hs | 15 ++++++++++-- 7 files changed, 74 insertions(+), 46 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index a924d63de..5ffc7c21d 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -68,12 +68,10 @@ machine = (SM.mkStateMachine Nothing transition isFinal) check t = member (Slot t) range range = txInfoValidRange $ scriptContextTxInfo ctx - getInputTime = \case - UserAct time _ _ -> Just time - PriceAct time _ -> Just time - _ -> Nothing - + UserAct time _ _ -> Just time + PriceAct time _ _ -> Just time + _ -> Nothing {-# INLINABLE mkValidator #-} mkValidator :: Scripts.ValidatorType Lendex @@ -162,8 +160,9 @@ type PriceOracleApp a = Contract () PriceOracleLendexSchema LendexError a priceOracleAction :: PriceAct -> PriceOracleApp () priceOracleAction act = do + pkh <- fmap pubKeyHash ownPubKey currentTimestamp <- getSlot <$> currentSlot - void $ SM.runStep client (PriceAct currentTimestamp act) + void $ SM.runStep client (PriceAct currentTimestamp (UserId pkh) act) -- | Endpoints for price oracle priceOracleEndpoints :: PriceOracleApp () @@ -179,6 +178,7 @@ type GovernLendexSchema = data StartParams = StartParams { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA , sp'initValue :: Value -- ^ init value deposited to the lending app + , sp'oracles :: [UserId] -- ^ trusted oracles } deriving stock (Show, Generic) deriving anyclass (FromJSON, ToJSON) @@ -191,7 +191,7 @@ governAction act = do startLendex :: StartParams -> GovernApp () startLendex StartParams{..} = do - void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins) sp'initValue + void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins sp'oracles) sp'initValue -- | Endpoints for admin user governEndpoints :: GovernApp () diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 0be290dbf..391148e86 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -44,17 +44,20 @@ data AppConfig = AppConfig -- no need to include it here , appConfig'currencySymbol :: CurrencySymbol -- ^ lending app main currency symbol + , appConfig'oracles :: [UserId] + -- ^ users that can submit price changes } -- | App is initialised with list of coins and their rates (value relative to base currency, ada for us) initApp :: AppConfig -> LendingApp initApp AppConfig{..} = App { app'st = LendingPool - { lp'reserves = (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) - , lp'users = AM.empty - , lp'currency = appConfig'currencySymbol - , lp'coinMap = coinMap - , lp'healthReport = AM.empty + { lp'reserves = (AM.fromList (fmap (\x -> (coinCfg'coin x, initReserve x)) appConfig'reserves)) + , lp'users = AM.empty + , lp'currency = appConfig'currencySymbol + , lp'coinMap = coinMap + , lp'healthReport = AM.empty + , lp'trustedOracles = appConfig'oracles } , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appConfig'users @@ -66,8 +69,9 @@ initApp AppConfig{..} = App -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. defaultAppConfig :: AppConfig -defaultAppConfig = AppConfig reserves users curSym +defaultAppConfig = AppConfig reserves users curSym oracles where + oracles = [UserId $ PubKeyHash "1"] -- only user 1 can set the price curSym = currencySymbol "lending-app" userNames = ["1", "2", "3"] coinNames = ["Dollar", "Euro", "Lira"] @@ -101,10 +105,10 @@ userAct uid act = do S.putAct $ UserAct time uid act -- | Make price act -priceAct :: PriceAct -> Script -priceAct arg = do +priceAct :: UserId -> PriceAct -> Script +priceAct uid arg = do t <- S.getCurrentTime - S.putAct $ PriceAct t arg + S.putAct $ PriceAct t uid arg -- | Make govern act governAct :: GovernAct -> Script diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index b9b2bded7..5524bc38f 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -38,9 +38,9 @@ react :: Act -> St [Resp] react input = do checkInput input case input of - UserAct t uid act -> withHealthCheck t $ userAct t uid act - PriceAct t act -> withHealthCheck t $ priceAct t act - GovernAct act -> governAct act + UserAct t uid act -> withHealthCheck t $ userAct t uid act + PriceAct t uid act -> withHealthCheck t $ priceAct t uid act + GovernAct act -> governAct act where -- | User acts userAct time uid = \case @@ -247,9 +247,11 @@ react input = do guardError "Bad borrow not present" isOk --------------------------------------------------- - priceAct currentTime = \case - SetAssetPrice coin rate -> setAssetPrice currentTime coin rate - SetOracleAddr coin addr -> setOracleAddr coin addr + priceAct currentTime uid act = do + isTrustedOracle uid + case act of + SetAssetPrice coin rate -> setAssetPrice currentTime coin rate + SetOracleAddr coin addr -> setOracleAddr coin addr --------------------------------------------------- -- update on market price change @@ -273,13 +275,13 @@ react input = do -- Adds new reserve (new coin/asset) addReserve cfg@CoinCfg{..} = do - LendingPool reserves users curSym coinMap healthReport <- get + LendingPool reserves users curSym coinMap healthReport oracles <- get if M.member coinCfg'coin reserves then throwError "Reserve is already present" else do let newReserves = M.insert coinCfg'coin (initReserve cfg) reserves newCoinMap = M.insert coinCfg'aToken coinCfg'coin coinMap - put $ LendingPool newReserves users curSym newCoinMap healthReport + put $ LendingPool newReserves users curSym newCoinMap healthReport oracles return [] --------------------------------------------------- @@ -333,7 +335,7 @@ checkInput = \case UserAct time _uid act -> do isNonNegative "timestamp" time checkUserAct act - PriceAct time act -> checkPriceAct time act + PriceAct time _uid act -> checkPriceAct time act GovernAct act -> checkGovernAct act where checkUserAct = \case diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 3160f0cf8..bd5a18b7c 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -12,6 +12,7 @@ module Mlabs.Lending.Logic.State( , Error , isAsset , aToken + , isTrustedOracle , updateReserveState , initReserve , guardError @@ -82,6 +83,12 @@ updateReserveState :: Integer -> Coin -> St () updateReserveState currentTime asset = modifyReserve asset $ IR.updateReserveInterestRates currentTime +{-# INLINABLE isTrustedOracle #-} +isTrustedOracle :: UserId -> St () +isTrustedOracle uid = do + oracles <- gets lp'trustedOracles + guardError "Is not trusted oracle" $ elem uid oracles + {-# INLINABLE aToken #-} aToken :: Coin -> St Coin aToken coin = do @@ -225,9 +232,9 @@ modifyReserve coin f = modifyReserve' coin (Right . f) -- | Modify reserve for a given asset. It can throw errors. modifyReserve' :: Coin -> (Reserve -> Either Error Reserve) -> St () modifyReserve' asset f = do - LendingPool lp users curSym coinMap healthReport <- get + LendingPool lp users curSym coinMap healthReport oracles <- get case M.lookup asset lp of - Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym coinMap healthReport) (f reserve) + Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym coinMap healthReport oracles) (f reserve) Nothing -> throwError $ "Asset is not supported" {-# INLINABLE modifyUser #-} @@ -239,10 +246,10 @@ modifyUser uid f = modifyUser' uid (Right . f) -- | Modify user info by id. It can throw errors. modifyUser' :: UserId -> (User -> Either Error User) -> St () modifyUser' uid f = do - LendingPool lp users curSym coinMap healthReport <- get + LendingPool lp users curSym coinMap healthReport oracles <- get case f $ fromMaybe defaultUser $ M.lookup uid users of Left msg -> throwError msg - Right user -> put $ LendingPool lp (M.insert uid user users) curSym coinMap healthReport + Right user -> put $ LendingPool lp (M.insert uid user users) curSym coinMap healthReport oracles {-# INLINABLE modifyHealthReport #-} modifyHealthReport :: (HealthReport -> HealthReport) -> St () diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index ea5e6340b..7898010cc 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -67,11 +67,12 @@ class Showt a where -- | Lending pool is a list of reserves data LendingPool = LendingPool - { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves - , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app - , lp'currency :: !CurrencySymbol -- ^ main currencySymbol of the app - , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins - , lp'healthReport :: !HealthReport -- ^ map of unhealthy borrows + { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves + , lp'users :: !(Map UserId User) -- ^ internal user wallets on the app + , lp'currency :: !CurrencySymbol -- ^ main currencySymbol of the app + , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins + , lp'healthReport :: !HealthReport -- ^ map of unhealthy borrows + , lp'trustedOracles :: ![UserId] -- ^ we accept price changes only for those users } deriving (Show, Generic) @@ -148,14 +149,15 @@ data CoinCfg = CoinCfg deriving anyclass (FromJSON, ToJSON) {-# INLINABLE initLendingPool #-} -initLendingPool :: CurrencySymbol -> [CoinCfg] -> LendingPool -initLendingPool curSym coinCfgs = +initLendingPool :: CurrencySymbol -> [CoinCfg] -> [UserId] -> LendingPool +initLendingPool curSym coinCfgs oracles = LendingPool - { lp'reserves = reserves - , lp'users = M.empty - , lp'currency = curSym - , lp'coinMap = coinMap - , lp'healthReport = M.empty + { lp'reserves = reserves + , lp'users = M.empty + , lp'currency = curSym + , lp'coinMap = coinMap + , lp'healthReport = M.empty + , lp'trustedOracles = oracles } where reserves = M.fromList $ fmap (\cfg -> (coinCfg'coin cfg, initReserve cfg)) coinCfgs @@ -234,6 +236,7 @@ data Act } -- ^ user's actions | PriceAct { priceAct'time :: Integer + , priceAct'userId :: UserId , priceAct'act :: PriceAct } -- ^ price oracle's actions | GovernAct GovernAct -- ^ app admin's actions diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 00d593b5c..4b1198a82 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -62,6 +62,7 @@ depositScript = do }) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] , sp'initValue = Value.assetClassValue adaCoin 1000 + , sp'oracles = [toUserId wAdmin] } wait 5 userAct1 $ DepositAct 50 coin1 @@ -201,7 +202,7 @@ repayScene = borrowScene <> repayChange liquidationCallScript :: Bool -> Trace.EmulatorTrace () liquidationCallScript receiveAToken = do borrowScript - priceAct $ SetAssetPrice coin2 (R.fromInteger 2) + priceAct wAdmin $ SetAssetPrice coin2 (R.fromInteger 2) next userAct2 $ LiquidationCallAct { act'collateral = coin1 @@ -226,6 +227,6 @@ liquidationCallScene receiveAToken = borrowScene <> liquidationCallChange -------------------------------------------------- -- names as in script test -priceAct :: PriceAct -> Trace.EmulatorTrace () -priceAct act = L.callPriceOracleAct w1 act +priceAct :: Wallet -> PriceAct -> Trace.EmulatorTrace () +priceAct wal act = L.callPriceOracleAct wal act diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 6407cf322..e11b23f28 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -29,6 +29,7 @@ test = testGroup "Logic" , testCase "Withdraw" testWithdraw , testCase "Repay" testRepay , testGroup "Borrow liquidation" testLiquidationCall + , testCase "Wrong user sets the price" testWrongUserPriceSet ] where testBorrow = testWallets [(user1, w1)] borrowScript @@ -73,6 +74,8 @@ test = testGroup "Logic" -- receive underlying currency w2 = BchWallet $ M.fromList [(coin2, 40), (aCoin2, 50) , (coin1, 20), (adaCoin, 1)] + testWrongUserPriceSet = someErrors $ testScript wrongUserPriceSetScript + -- | Checks that script runs without errors testScript :: Script -> LendingApp testScript script = runLendingApp testAppConfig script @@ -170,7 +173,7 @@ repayScript = do liquidationCallScript :: Bool -> Script liquidationCallScript receiveAToken = do borrowScript - priceAct $ SetAssetPrice coin2 (R.fromInteger 2) + priceAct user1 $ SetAssetPrice coin2 (R.fromInteger 2) userAct user2 $ LiquidationCallAct { act'collateral = coin1 , act'debt = BadBorrow user1 coin2 @@ -178,6 +181,12 @@ liquidationCallScript receiveAToken = do , act'receiveAToken = receiveAToken } +-- oracles + +wrongUserPriceSetScript :: Script +wrongUserPriceSetScript = do + priceAct user2 $ SetAssetPrice coin2 (R.fromInteger 2) + --------------------------------- -- constants @@ -216,8 +225,10 @@ aCoin2 = fromToken aToken2 -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. testAppConfig :: AppConfig -testAppConfig = AppConfig reserves users lendingPoolCurrency +testAppConfig = AppConfig reserves users lendingPoolCurrency oracles where + oracles = [user1] + reserves = fmap (\(coin, aCoin) -> CoinCfg { coinCfg'coin = coin , coinCfg'rate = R.fromInteger 1 From f8d5397d48ed5c010a0a98fc9158bf00dff1c0b0 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 28 May 2021 14:06:58 +0300 Subject: [PATCH 46/81] Remove some redundant stuff --- mlabs/src/Mlabs/Lending/Contract/Utils.hs | 1 + mlabs/src/Mlabs/Lending/Logic/React.hs | 8 ------ mlabs/src/Mlabs/Lending/Logic/State.hs | 1 - mlabs/src/Mlabs/Lending/Logic/Types.hs | 30 ----------------------- 4 files changed, 1 insertion(+), 39 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Contract/Utils.hs b/mlabs/src/Mlabs/Lending/Contract/Utils.hs index c3e18959f..36bed0ef4 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Utils.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Utils.hs @@ -13,3 +13,4 @@ readDatum txOut = do Datum e <- lookupDatum (txOutTxTx txOut) h PlutusTx.fromData e + diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 5524bc38f..ecc7142ef 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -251,7 +251,6 @@ react input = do isTrustedOracle uid case act of SetAssetPrice coin rate -> setAssetPrice currentTime coin rate - SetOracleAddr coin addr -> setOracleAddr coin addr --------------------------------------------------- -- update on market price change @@ -260,11 +259,6 @@ react input = do modifyReserve asset $ \r -> r { reserve'rate = CoinRate rate currentTime } pure [] - --------------------------------------------------- - -- set oracle address - -- - setOracleAddr _ _ = todo - --------------------------------------------------- -- Govern acts @@ -367,8 +361,6 @@ checkInput = \case checkCoinRateTimeProgress time asset isPositiveRational "price" price isAsset asset - SetOracleAddr asset _uid -> - isAsset asset checkGovernAct = \case AddReserve cfg -> checkCoinCfg cfg diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index bd5a18b7c..6b4dc9664 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -8,7 +8,6 @@ -- | State transitions for Lending app module Mlabs.Lending.Logic.State( St - , showt , Error , isAsset , aToken diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 7898010cc..e3105df43 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -34,17 +34,10 @@ module Mlabs.Lending.Logic.Types( , BadBorrow(..) , PriceAct(..) , GovernAct(..) - , LpAddressesProvider(..) - , LpAddressesProviderRegistry(..) , Coin , toLendingToken , fromLendingToken , fromAToken - , LpCollateralManager(..) - , LpConfigurator(..) - , PriceOracleProvider(..) - , InterestRateStrategy(..) - , Showt(..) ) where import Data.Aeson (FromJSON, ToJSON) @@ -60,11 +53,6 @@ import GHC.Generics import Mlabs.Emulator.Types --- | Class that converts to inlinable builtin string -class Showt a where - showt :: a -> String - - -- | Lending pool is a list of reserves data LendingPool = LendingPool { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves @@ -302,7 +290,6 @@ data GovernAct -- | Updates for the prices of the currencies on the markets data PriceAct = SetAssetPrice Coin Rational -- ^ Set asset price - | SetOracleAddr Coin UserId -- ^ Provide address of the oracle deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) @@ -319,23 +306,6 @@ fromAToken LendingPool{..} tn = M.lookup tn lp'coinMap fromLendingToken :: LendingPool -> Coin -> Maybe Coin fromLendingToken lp (AssetClass (_ ,tn)) = fromAToken lp tn ----------------------------------------------------- --- some types specific to aave --- - -data LpAddressesProvider = LpAddressesProvider - -newtype LpAddressesProviderRegistry - = LpAddressesProviderRegistry [LpAddressesProvider] - -data LpCollateralManager = LpCollateralManager - -data LpConfigurator = LpConfigurator - -data PriceOracleProvider = PriceOracleProvider - -data InterestRateStrategy = InterestRateStrategy - data InterestRate = StableRate | VariableRate deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) From 26fb9b36eaeeee2eb63a2bc068823d8458325d27 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 28 May 2021 16:20:51 +0300 Subject: [PATCH 47/81] Adds unique identifier for Lendex --- mlabs/src/Mlabs/Lending/Contract/Forge.hs | 35 +++--- mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 130 +++++++++++---------- mlabs/src/Mlabs/Lending/Logic/Types.hs | 9 ++ mlabs/test/Test/Lending/Contract.hs | 6 +- mlabs/test/Test/Lending/Init.hs | 15 ++- 5 files changed, 110 insertions(+), 85 deletions(-) diff --git a/mlabs/src/Mlabs/Lending/Contract/Forge.hs b/mlabs/src/Mlabs/Lending/Contract/Forge.hs index 0f420681b..65d13ce75 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Forge.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Forge.hs @@ -20,8 +20,9 @@ import Mlabs.Lending.Logic.Types import Mlabs.Lending.Logic.State data Input = Input - { input'state :: !LendingPool - , input'value :: !Value.Value + { input'lendexId :: !LendexId + , input'state :: !LendingPool + , input'value :: !Value.Value } {-# INLINABLE validate #-} @@ -45,13 +46,18 @@ data Input = Input -- -- Note that during burn user does not pay aTokens to the app they just get burned. -- Only app pays to user in compensation for burn. -validate :: ScriptContext -> Bool -validate ctx = case (getInState, getOutState) of - (Just st1, Just st2) -> all (isValidForge st1 st2) $ Value.flattenValue $ txInfoForge info +validate :: LendexId -> ScriptContext -> Bool +validate lendexId ctx = case (getInState, getOutState) of + (Just st1, Just st2) -> + if (hasLendexId st1 && hasLendexId st2) + then all (isValidForge st1 st2) $ Value.flattenValue $ txInfoForge info + else traceIfFalse "Bad Lendex identifier" False (Just _ , Nothing) -> traceIfFalse "Failed to find LendingPool state in outputs" False (Nothing, Just _) -> traceIfFalse "Failed to find LendingPool state in inputs" False _ -> traceIfFalse "Failed to find TxOut with LendingPool state" False where + hasLendexId x = input'lendexId x == lendexId + -- find datum of lending app state in the inputs getInState = getStateForOuts $ fmap txInInfoResolved $ txInfoInputs info @@ -64,8 +70,8 @@ validate ctx = case (getInState, getOutState) of stateForTxOut out = do dHash <- txOutDatumHash out dat <- Scripts.getDatum <$> findDatum dHash info - st <- PlutusTx.fromData dat - pure $ Input st (txOutValue out) + (lid, st) <- PlutusTx.fromData dat + pure $ Input lid st (txOutValue out) isValidForge :: Input -> Input -> (Value.CurrencySymbol, Value.TokenName, Integer) -> Bool isValidForge st1 st2 (cur, token, amount) = case getTokenCoin st1 st2 cur token of @@ -86,7 +92,7 @@ validate ctx = case (getInState, getOutState) of -- checks that user deposit becomes larger on given amount of minted tokens -- and user pays given amount to the lending app. We go through the list of all signatures -- to see if anyone acts as a user (satisfy constraints). - isValidMint (Input st1 stVal1) (Input st2 stVal2) coin aCoin amount = + isValidMint (Input _ st1 stVal1) (Input _ st2 stVal2) coin aCoin amount = traceIfFalse "No user is allowed to mint" $ any checkUserMint users where checkUserMint uid = @@ -107,7 +113,7 @@ validate ctx = case (getInState, getOutState) of checkScriptPays uid = traceIfFalse "User has not received aCoins for Mint" $ checkScriptContext (mustPayToPubKey uid $ Value.assetClassValue aCoin amount :: TxConstraints () ()) ctx - isValidBurn (Input st1 _stVal1) (Input st2 _stVal2) coin _aCoin amount = + isValidBurn (Input _lendexId1 st1 _stVal1) (Input _lendexId2 st2 _stVal2) coin _aCoin amount = traceIfFalse "No user is allowed to burn" $ any checkUserBurn users where checkUserBurn uid = @@ -135,10 +141,11 @@ validate ctx = case (getInState, getOutState) of ------------------------------------------------------------------------------- -currencyPolicy :: MonetaryPolicy -currencyPolicy = Scripts.mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy validate ||]) +currencyPolicy :: LendexId -> MonetaryPolicy +currencyPolicy lid = Scripts.mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . validate ||]) + `PlutusTx.applyCode` (PlutusTx.liftCode lid) -currencySymbol :: CurrencySymbol -currencySymbol = scriptCurrencySymbol currencyPolicy +currencySymbol :: LendexId -> CurrencySymbol +currencySymbol lid = scriptCurrencySymbol (currencyPolicy lid) diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 5ffc7c21d..1c0186190 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -53,12 +53,11 @@ import qualified Wallet.Emulator as Emulator import qualified Data.Map as M -- import Data.Text.Prettyprint.Doc.Extras - -type Lendex = SM.StateMachine LendingPool Act +type Lendex = SM.StateMachine (LendexId, LendingPool) Act {-# INLINABLE machine #-} -machine :: Lendex -machine = (SM.mkStateMachine Nothing transition isFinal) +machine :: LendexId -> Lendex +machine lid = (SM.mkStateMachine Nothing (transition lid) isFinal) { SM.smCheck = checkTimestamp } where isFinal = const False @@ -74,36 +73,43 @@ machine = (SM.mkStateMachine Nothing transition isFinal) _ -> Nothing {-# INLINABLE mkValidator #-} -mkValidator :: Scripts.ValidatorType Lendex -mkValidator = SM.mkValidator machine +mkValidator :: LendexId -> Scripts.ValidatorType Lendex +mkValidator lid = SM.mkValidator (machine lid) -client :: SM.StateMachineClient LendingPool Act -client = SM.mkStateMachineClient $ SM.StateMachineInstance machine scriptInstance +client :: LendexId -> SM.StateMachineClient (LendexId, LendingPool) Act +client lid = SM.mkStateMachineClient $ SM.StateMachineInstance (machine lid) (scriptInstance lid) -lendexValidatorHash :: ValidatorHash -lendexValidatorHash = Scripts.scriptHash scriptInstance +lendexValidatorHash :: LendexId -> ValidatorHash +lendexValidatorHash lid = Scripts.scriptHash (scriptInstance lid) -lendexAddress :: Address -lendexAddress = scriptHashAddress lendexValidatorHash +lendexAddress :: LendexId -> Address +lendexAddress lid = scriptHashAddress (lendexValidatorHash lid) -scriptInstance :: Scripts.ScriptInstance Lendex -scriptInstance = Scripts.validator @Lendex - $$(PlutusTx.compile [|| mkValidator ||]) +scriptInstance :: LendexId -> Scripts.ScriptInstance Lendex +scriptInstance lid = Scripts.validator @Lendex + ($$(PlutusTx.compile [|| mkValidator ||]) + `PlutusTx.applyCode` (PlutusTx.liftCode lid) + ) $$(PlutusTx.compile [|| wrap ||]) where wrap = Scripts.wrapValidator {-# INLINABLE transition #-} transition :: - SM.State LendingPool + LendexId + -> SM.State (LendexId, LendingPool) -> Act - -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State LendingPool) -transition SM.State{stateData=oldData, stateValue=oldValue} input = case runStateT (react input) oldData of - Left _err -> Nothing - Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints - , SM.State { stateData = newData - , stateValue = updateRespValue resps oldValue }) + -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State (LendexId, LendingPool)) +transition lid SM.State{stateData=oldData, stateValue=oldValue} input + | lid == inputLid = case runStateT (react input) (snd oldData) of + Left _err -> Nothing + Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints + , SM.State { stateData = (lid, newData) + , stateValue = updateRespValue resps oldValue }) + | otherwise = Nothing where + inputLid = fst oldData + -- we check that user indeed signed the transaction with his own key ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId @@ -122,22 +128,22 @@ type UserLendexSchema = type UserApp a = Contract () UserLendexSchema LendexError a -findInputStateDatum :: UserApp Datum -findInputStateDatum = do - utxos <- utxoAt lendexAddress +findInputStateDatum :: LendexId -> UserApp Datum +findInputStateDatum lid = do + utxos <- utxoAt (lendexAddress lid) maybe err P.pure $ firstJust (readDatum . snd) $ M.toList utxos where err = throwError $ SM.SMCContractError "Can not find Lending app instance" -userAction :: UserAct -> UserApp () -userAction act = do +userAction :: LendexId -> UserAct -> UserApp () +userAction lid act = do currentTimestamp <- getSlot <$> currentSlot pkh <- fmap pubKeyHash ownPubKey - inputDatum <- findInputStateDatum - let lookups = monetaryPolicy Forge.currencyPolicy P.<> + inputDatum <- findInputStateDatum lid + let lookups = monetaryPolicy (Forge.currencyPolicy lid) P.<> ownPubKeyHash pkh constraints = mustIncludeDatum inputDatum - t <- SM.mkStep client (UserAct currentTimestamp (UserId pkh) act) + t <- SM.mkStep (client lid) (UserAct currentTimestamp (UserId pkh) act) logInfo @String $ "Executes action " P.<> show act case t of Left _err -> logError ("Action failed" :: String) @@ -147,10 +153,10 @@ userAction act = do awaitTxConfirmed (txId tx) -- | Endpoints for user -userEndpoints :: UserApp () -userEndpoints = forever userAction' +userEndpoints :: LendexId -> UserApp () +userEndpoints lid = forever userAction' where - userAction' = endpoint @"user-action" >>= userAction + userAction' = endpoint @"user-action" >>= userAction lid type PriceOracleLendexSchema = BlockchainActions @@ -158,17 +164,17 @@ type PriceOracleLendexSchema = type PriceOracleApp a = Contract () PriceOracleLendexSchema LendexError a -priceOracleAction :: PriceAct -> PriceOracleApp () -priceOracleAction act = do +priceOracleAction :: LendexId -> PriceAct -> PriceOracleApp () +priceOracleAction lid act = do pkh <- fmap pubKeyHash ownPubKey currentTimestamp <- getSlot <$> currentSlot - void $ SM.runStep client (PriceAct currentTimestamp (UserId pkh) act) + void $ SM.runStep (client lid) (PriceAct currentTimestamp (UserId pkh) act) -- | Endpoints for price oracle -priceOracleEndpoints :: PriceOracleApp () -priceOracleEndpoints = forever priceOracleAction' +priceOracleEndpoints :: LendexId -> PriceOracleApp () +priceOracleEndpoints lid = forever priceOracleAction' where - priceOracleAction' = endpoint @"price-oracle-action" >>= priceOracleAction + priceOracleAction' = endpoint @"price-oracle-action" >>= priceOracleAction lid type GovernLendexSchema = BlockchainActions @@ -185,47 +191,45 @@ data StartParams = StartParams type GovernApp a = Contract () GovernLendexSchema LendexError a -governAction :: GovernAct -> GovernApp () -governAction act = do - void $ SM.runStep client (GovernAct act) +governAction :: LendexId -> GovernAct -> GovernApp () +governAction lid act = do + void $ SM.runStep (client lid) (GovernAct act) -startLendex :: StartParams -> GovernApp () -startLendex StartParams{..} = do - void $ SM.runInitialise client (initLendingPool Forge.currencySymbol sp'coins sp'oracles) sp'initValue +startLendex :: LendexId -> StartParams -> GovernApp () +startLendex lid StartParams{..} = do + void $ SM.runInitialise (client lid) (lid, initLendingPool (Forge.currencySymbol lid) sp'coins sp'oracles) sp'initValue -- | Endpoints for admin user -governEndpoints :: GovernApp () -governEndpoints = startLendex' >> forever governAction' +governEndpoints :: LendexId -> GovernApp () +governEndpoints lid = startLendex' >> forever governAction' where - governAction' = endpoint @"govern-action" >>= governAction - startLendex' = endpoint @"start-lendex" >>= startLendex - ---------------------------------------------------------- + governAction' = endpoint @"govern-action" >>= (governAction lid) + startLendex' = endpoint @"start-lendex" >>= (startLendex lid) --------------------------------------------------------- -- call endpoints (for debug and testing) -- | Calls user act -callUserAct :: Emulator.Wallet -> UserAct -> EmulatorTrace () -callUserAct wal act = do - hdl <- activateContractWallet wal userEndpoints +callUserAct :: LendexId -> Emulator.Wallet -> UserAct -> EmulatorTrace () +callUserAct lid wal act = do + hdl <- activateContractWallet wal (userEndpoints lid) void $ callEndpoint @"user-action" hdl act -- | Calls price oracle act -callPriceOracleAct :: Emulator.Wallet -> PriceAct -> EmulatorTrace () -callPriceOracleAct wal act = do - hdl <- activateContractWallet wal priceOracleEndpoints +callPriceOracleAct :: LendexId -> Emulator.Wallet -> PriceAct -> EmulatorTrace () +callPriceOracleAct lid wal act = do + hdl <- activateContractWallet wal (priceOracleEndpoints lid) void $ callEndpoint @"price-oracle-action" hdl act -- | Calls govern act -callGovernAct :: Emulator.Wallet -> GovernAct -> EmulatorTrace () -callGovernAct wal act = do - hdl <- activateContractWallet wal governEndpoints +callGovernAct :: LendexId -> Emulator.Wallet -> GovernAct -> EmulatorTrace () +callGovernAct lid wal act = do + hdl <- activateContractWallet wal (governEndpoints lid) void $ callEndpoint @"govern-action" hdl act -- | Calls initialisation of state for Lending pool -callStartLendex :: Emulator.Wallet -> StartParams -> EmulatorTrace () -callStartLendex wal sp = do - hdl <- activateContractWallet wal governEndpoints +callStartLendex :: LendexId -> Emulator.Wallet -> StartParams -> EmulatorTrace () +callStartLendex lid wal sp = do + hdl <- activateContractWallet wal (governEndpoints lid) void $ callEndpoint @"start-lendex" hdl sp diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index e3105df43..c3779d133 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -13,6 +13,7 @@ -- * https://docs.aave.com/developers/v/2.0/the-core-protocol/lendingpool module Mlabs.Lending.Logic.Types( LendingPool(..) + , LendexId(..) , Wallet(..) , defaultWallet , User(..) @@ -53,6 +54,12 @@ import GHC.Generics import Mlabs.Emulator.Types +-- | Unique identifier of the lending pool state. +newtype LendexId = LendexId ByteString + deriving stock (Show, Generic) + deriving newtype (Eq) + deriving anyclass (ToJSON, FromJSON) + -- | Lending pool is a list of reserves data LendingPool = LendingPool { lp'reserves :: !(Map Coin Reserve) -- ^ list of reserves @@ -328,3 +335,5 @@ PlutusTx.unstableMakeIsData ''BadBorrow PlutusTx.unstableMakeIsData ''LendingPool PlutusTx.unstableMakeIsData ''Act +PlutusTx.unstableMakeIsData ''LendexId +PlutusTx.makeLift ''LendexId diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 4b1198a82..281e30f80 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -52,7 +52,7 @@ test = testGroup "Contract" -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. depositScript :: Trace.EmulatorTrace () depositScript = do - L.callStartLendex wAdmin $ L.StartParams + L.callStartLendex lendexId wAdmin $ L.StartParams { sp'coins = fmap (\(coin, aCoin) -> CoinCfg { coinCfg'coin = coin , coinCfg'rate = R.fromInteger 1 @@ -74,7 +74,7 @@ depositScript = do depositScene :: Scene depositScene = mconcat - [ appAddress L.lendexAddress + [ appAddress (L.lendexAddress lendexId) , appOwns [(coin1, 50), (coin2, 50), (coin3, 50), (adaCoin, 1000)] , user w1 coin1 aCoin1 , user w2 coin2 aCoin2 @@ -228,5 +228,5 @@ liquidationCallScene receiveAToken = borrowScene <> liquidationCallChange -- names as in script test priceAct :: Wallet -> PriceAct -> Trace.EmulatorTrace () -priceAct wal act = L.callPriceOracleAct wal act +priceAct wal act = L.callPriceOracleAct lendexId wal act diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index 1fd4627ca..c4ff9c43f 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -8,6 +8,7 @@ module Test.Lending.Init( , aCoin1, aCoin2, aCoin3 , initialDistribution , toUserId + , lendexId ) where import Prelude @@ -23,7 +24,7 @@ import qualified Data.Map as M import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace -import Mlabs.Lending.Logic.Types (Coin, UserAct(..), UserId(..)) +import Mlabs.Lending.Logic.Types (LendexId(..), Coin, UserAct(..), UserId(..)) import qualified Mlabs.Lending.Logic.App as L import qualified Mlabs.Lending.Contract.Lendex as L import qualified Mlabs.Lending.Contract.Forge as Forge @@ -41,11 +42,15 @@ w3 = Wallet 3 toUserId :: Wallet -> UserId toUserId = UserId . pubKeyHash . walletPubKey +-- | Identifier for our lendex platform +lendexId :: LendexId +lendexId = LendexId "MLabs lending platform" + -- | Showrtcuts for user actions userAct1, userAct2, userAct3 :: UserAct -> Trace.EmulatorTrace () -userAct1 = L.callUserAct w1 -userAct2 = L.callUserAct w2 -userAct3 = L.callUserAct w3 +userAct1 = L.callUserAct lendexId w1 +userAct2 = L.callUserAct lendexId w2 +userAct3 = L.callUserAct lendexId w3 -- | Coins which are used for testing adaCoin, coin1, coin2, coin3 :: Coin @@ -65,7 +70,7 @@ adaCoin = Value.AssetClass (Ada.adaSymbol, Ada.adaToken) -- | Convert aToken to aCoin fromToken :: TokenName -> Coin -fromToken aToken = Value.AssetClass (Forge.currencySymbol, aToken) +fromToken aToken = Value.AssetClass (Forge.currencySymbol lendexId, aToken) -- | aCoins that correspond to real coins aCoin1, aCoin2, aCoin3 :: Coin From 598919cfe0332abd0d965a5fd51dc3be1efb7947 Mon Sep 17 00:00:00 2001 From: anton-k Date: Fri, 28 May 2021 16:57:32 +0300 Subject: [PATCH 48/81] Fix collateral lock for reserve --- mlabs/src/Mlabs/Lending/Logic/React.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index ecc7142ef..abab3b673 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -137,7 +137,7 @@ react input = do | otherwise = do ni <- getNormalisedIncome asset amount <- getAmountBy wallet'deposit uid asset portion - modifyWalletAndReserve' uid asset $ \w -> do + modifyWallet' uid asset $ \w -> do w1 <- addDeposit ni (negate amount) w pure $ w1 { wallet'collateral = wallet'collateral w + amount } aCoin <- aToken asset From 9277ebf43e95d53b96896cd52e1a6bc400724c7a Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 31 May 2021 13:56:07 +0300 Subject: [PATCH 49/81] Add Ray math --- mlabs/mlabs-plutus-use-cases.cabal | 38 +++++++++++ mlabs/src/Mlabs/Data/Ray.hs | 98 +++++++++++++++++++++++++++++ mlabs/src/Mlabs/Emulator/Types.hs | 1 + mlabs/src/Mlabs/Nft/Contract/Nft.hs | 47 +++++++++++--- mlabs/src/Mlabs/Nft/Logic/App.hs | 3 +- mlabs/src/Mlabs/Nft/Logic/State.hs | 2 +- mlabs/src/Mlabs/Nft/Logic/Types.hs | 8 ++- mlabs/test/Test/Nft/Init.hs | 2 +- 8 files changed, 183 insertions(+), 16 deletions(-) create mode 100644 mlabs/src/Mlabs/Data/Ray.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 627de50df..fc6acc52f 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -22,6 +22,7 @@ library Ghc-Options: -Wall build-depends: base >=4.14 && <4.15 , aeson + , ansi-terminal , bytestring , containers , extra @@ -53,6 +54,7 @@ library Mlabs.Data.AssocMap Mlabs.Data.List Mlabs.Data.Maybe + Mlabs.Data.Ray Mlabs.Data.Ord Mlabs.Emulator.App Mlabs.Emulator.Blockchain @@ -73,7 +75,9 @@ library Mlabs.Nft.Logic.Types Mlabs.Nft.Contract.Nft Mlabs.Nft.Contract.Forge + Mlabs.Nft.Contract.Pab Mlabs.Plutus.Contract.StateMachine + Mlabs.System.Console.PrettyLogger default-extensions: BangPatterns ExplicitForAll FlexibleContexts @@ -102,6 +106,7 @@ library FlexibleInstances TypeSynonymInstances TupleSections + NumericUnderscores executable mlabs-plutus-use-cases main-is: app/Main.hs @@ -122,6 +127,39 @@ executable mlabs-plutus-use-cases , freer-extras default-language: Haskell2010 +executable nft-demo + main-is: nft-demo/Main.hs + build-depends: base >=4.14 && <4.15 + , aeson + , bytestring + , containers + , playground-common + , plutus-core + , plutus-contract + , plutus-ledger + , plutus-ledger-api + , plutus-tx + , plutus-tx-plugin + , plutus-pab + , prettyprinter + , lens + , text + , freer-extras + , freer-simple + , mlabs-plutus-use-cases + , ansi-terminal + , bytestring + , cardano-prelude + , data-default-class + , lens + , playground-common + , prettyprinter + , row-types + , vector + default-language: Haskell2010 + default-extensions: AllowAmbiguousTypes BlockArguments BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase ExplicitNamespaces FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns ImportQualifiedPost RoleAnnotations + + Test-suite mlabs-plutus-use-cases-tests Type: exitcode-stdio-1.0 Ghc-options: -Wall -threaded -rtsopts diff --git a/mlabs/src/Mlabs/Data/Ray.hs b/mlabs/src/Mlabs/Data/Ray.hs new file mode 100644 index 000000000..4b73dd693 --- /dev/null +++ b/mlabs/src/Mlabs/Data/Ray.hs @@ -0,0 +1,98 @@ +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fno-specialize #-} +{-# OPTIONS_GHC -fno-strictness #-} +{-# OPTIONS_GHC -fobject-code #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +-- | Ray math +-- +-- We can represent fractional units with integers with 27 decimals precision +module Mlabs.Data.Ray( + Ray(..) + , fromInteger + , (%) + , fromRational + , toRational + , recip + , round + , properFraction +) where + +import Data.Aeson + +import GHC.Generics + +import qualified Prelude as Hask +import PlutusTx (IsData, Lift) +import PlutusCore.Universe (DefaultUni) +import PlutusTx.Prelude hiding (fromInteger, fromRational, recip, (%), round, properFraction, toRational) +import Playground.Contract (ToSchema) +import qualified PlutusTx.Ratio as R + +{-# INLINABLE base #-} +-- | Base precision +base :: Integer +base = 1_000_000_000_000_000_000_000_000_000 + +{-# INLINABLE squareBase #-} +-- | base * base +squareBase :: Integer +squareBase = 1_000_000_000_000_000_000_000_000_000_000_000_000_000_000_000_000_000_000 + +-- | We represent fractionals with 27 precision +newtype Ray = Ray Integer + deriving stock (Show, Generic) + deriving newtype ( AdditiveSemigroup, AdditiveMonoid, AdditiveGroup + , Eq, Ord + , Hask.Eq, Hask.Ord + , FromJSON, ToJSON + , IsData + , Lift DefaultUni + , ToSchema) + +instance MultiplicativeSemigroup Ray where + {-# INLINABLE (*) #-} + (*) (Ray a) (Ray b) = Ray $ (a * b * base) `divide` squareBase + +instance MultiplicativeMonoid Ray where + {-# INLINABLE one #-} + one = Ray base + +{-# INLINABLE (%) #-} +-- | Construct Ray as rationals +(%) :: Integer -> Integer -> Ray +(%) a b = fromRational (a R.% b) + +{-# INLINABLE fromInteger #-} +-- | Convert from Integer. +fromInteger :: Integer -> Ray +fromInteger n = Ray (n * base) + +{-# INLINABLE fromRational #-} +-- | Convert from Rational +fromRational :: Rational -> Ray +fromRational r = Ray $ (R.numerator r * base) `divide` R.denominator r + +{-# INLINABLE toRational #-} +toRational :: Ray -> Rational +toRational (Ray a) = R.reduce a base + +{-# INLINABLE recip #-} +-- | Reciprocal of ray. +-- +-- equals to: base * base / ray +recip :: Ray -> Ray +recip (Ray a) = Ray (squareBase `divide` a) + +{-# INLINABLE round #-} +-- | Round ray. +round :: Ray -> Integer +round (Ray a) = a `divide` base + +{-# INLINABLE properFraction #-} +properFraction :: Ray -> (Integer, Ray) +properFraction (Ray a) = (d, Ray m) + where + (d, m) = divMod a base + diff --git a/mlabs/src/Mlabs/Emulator/Types.hs b/mlabs/src/Mlabs/Emulator/Types.hs index 117bb8f0c..4c47da7e1 100644 --- a/mlabs/src/Mlabs/Emulator/Types.hs +++ b/mlabs/src/Mlabs/Emulator/Types.hs @@ -28,6 +28,7 @@ data UserId deriving stock (Show, Generic, Hask.Eq, Hask.Ord) deriving anyclass (FromJSON, ToJSON) + instance Eq UserId where {-# INLINABLE (==) #-} Self == Self = True diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs index 940224cf7..ad8b8e130 100644 --- a/mlabs/src/Mlabs/Nft/Contract/Nft.hs +++ b/mlabs/src/Mlabs/Nft/Contract/Nft.hs @@ -7,6 +7,10 @@ module Mlabs.Nft.Contract.Nft( , callUserAct , callStartNft , StartParams(..) + , UserSchema + , AuthorSchema + , startNft + , userEndpoints ) where import qualified Prelude as P @@ -30,6 +34,7 @@ import Ledger.Constraints import qualified PlutusTx as PlutusTx import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) import qualified Control.Monad.Freer.Error as F +import Playground.Contract (ToSchema) import Mlabs.Emulator.Blockchain import Mlabs.Emulator.Types @@ -46,6 +51,8 @@ import qualified Wallet.Emulator as Emulator import qualified Data.Map as M import Plutus.V1.Ledger.Value +import Mlabs.Data.Ray (Ray) + -------------------------------------- type NftMachine = SM.StateMachine Nft Act @@ -136,12 +143,26 @@ nftValue nid = assetClassValue (nftCoin nid) 1 type NftError = SM.SMContractError -- | User schema. Owner can set the price and the buyer can try to buy. -type NftSchema = +type UserSchema = BlockchainActions - .\/ Endpoint "user-action" UserAct + .\/ Endpoint "buy-act" BuyAct + .\/ Endpoint "set-price-act" SetPriceAct + +data BuyAct = BuyAct + { buy'price :: Integer + , buy'newPrice :: Maybe Integer + } + deriving stock (Show, Generic, P.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +data SetPriceAct = SetPriceAct + { setPrice'newPrice :: Maybe Integer + } + deriving stock (Show, Generic, P.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) -- | NFT contract for the user -type NftContract a = Contract () NftSchema NftError a +type NftContract a = Contract () UserSchema NftError a -- | Finds Datum for NFT state machine script. findInputStateDatum :: NftId -> NftContract Datum @@ -176,22 +197,26 @@ userAction nid act = do userEndpoints :: NftId -> NftContract () userEndpoints nid = forever userAction' where - userAction' = endpoint @"user-action" >>= (userAction nid) + userAction' = buy `select` setPrice + + buy = endpoint @"buy-act" >>= (\BuyAct{..} -> userAction nid (Buy buy'price buy'newPrice)) + setPrice = endpoint @"set-price-act" >>= (\SetPriceAct{..} -> userAction nid (SetPrice setPrice'newPrice)) + -- | Parameters to init NFT data StartParams = StartParams - { sp'content :: ByteString -- ^ NFT content - , sp'share :: Rational -- ^ author share [0, 1] on reselling of the NFT - , sp'price :: Maybe Integer -- ^ current price of NFT, if it's nothing then nobody can buy it. + { sp'content :: ByteString -- ^ NFT content + , sp'share :: Ray -- ^ author share [0, 1] on reselling of the NFT + , sp'price :: Maybe Integer -- ^ current price of NFT, if it's nothing then nobody can buy it. } deriving stock (Show, Generic) deriving anyclass (FromJSON, ToJSON) -- | Contract for the author of NFT -type AuthorContract a = Contract (Last NftId) AuthorScheme NftError a +type AuthorContract a = Contract (Last NftId) AuthorSchema NftError a -- | Schema for the author of NFT -type AuthorScheme = +type AuthorSchema = BlockchainActions .\/ Endpoint "start-nft" StartParams @@ -224,7 +249,9 @@ authorEndpoints = forever startNft' callUserAct :: NftId -> Emulator.Wallet -> UserAct -> EmulatorTrace () callUserAct nid wal act = do hdl <- Trace.activateContractWallet wal (userEndpoints nid) - void $ Trace.callEndpoint @"user-action" hdl act + case act of + Buy{..} -> void $ Trace.callEndpoint @"buy-act" hdl (BuyAct act'price act'newPrice) + SetPrice{..} -> void $ Trace.callEndpoint @"set-price-act" hdl (SetPriceAct act'newPrice) -- | Calls initialisation of state for Lending pool callStartNft :: Emulator.Wallet -> StartParams -> EmulatorTrace NftId diff --git a/mlabs/src/Mlabs/Nft/Logic/App.hs b/mlabs/src/Mlabs/Nft/Logic/App.hs index 05ff8f693..046eaf7ac 100644 --- a/mlabs/src/Mlabs/Nft/Logic/App.hs +++ b/mlabs/src/Mlabs/Nft/Logic/App.hs @@ -24,6 +24,7 @@ import Mlabs.Nft.Logic.React import Mlabs.Nft.Logic.Types import qualified Data.Map.Strict as M +import qualified Mlabs.Data.Ray as R -- | NFT test emulator. We use it test the logic. type NftApp = App Nft Act @@ -43,7 +44,7 @@ runNftApp cfg acts = runApp react (initApp cfg) acts -- | Initialise NFT application. initApp :: AppCfg -> NftApp initApp AppCfg{..} = App - { app'st = initNft appCfg'nftInRef appCfg'nftAuthor appCfg'nftData (1 % 10) Nothing + { app'st = initNft appCfg'nftInRef appCfg'nftAuthor appCfg'nftData (R.fromRational $ 1 % 10) Nothing , app'log = [] , app'wallets = BchState $ M.fromList $ (Self, defaultBchWallet) : appCfg'users } diff --git a/mlabs/src/Mlabs/Nft/Logic/State.hs b/mlabs/src/Mlabs/Nft/Logic/State.hs index ab3718e88..d2e0e7910 100644 --- a/mlabs/src/Mlabs/Nft/Logic/State.hs +++ b/mlabs/src/Mlabs/Nft/Logic/State.hs @@ -14,7 +14,7 @@ module Mlabs.Nft.Logic.State( , getAuthorShare ) where -import qualified PlutusTx.Ratio as R +import qualified Mlabs.Data.Ray as R import PlutusTx.Prelude import Mlabs.Control.Monad.State diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index 64ca52c0f..6b7043308 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -25,17 +25,19 @@ import GHC.Generics import Playground.Contract (TxOutRef) import Mlabs.Emulator.Types (UserId(..)) +import Mlabs.Data.Ray (Ray) -- | Data for NFTs data Nft = Nft { nft'id :: NftId -- ^ token name, unique identifier for NFT , nft'data :: ByteString -- ^ data (media, audio, photo, etc) - , nft'share :: Rational -- ^ share for the author on each sell + , nft'share :: Ray -- ^ share for the author on each sell , nft'author :: UserId -- ^ author , nft'owner :: UserId -- ^ current owner , nft'price :: Maybe Integer -- ^ price in ada, if it's nothing then nobody can buy } - deriving (Show, Generic) + deriving stock (Show, Generic) + deriving anyclass (ToJSON, FromJSON) -- | Unique identifier of NFT. data NftId = NftId @@ -53,7 +55,7 @@ instance Eq NftId where {-# INLINABLE initNft #-} -- | Initialise NFT -initNft :: TxOutRef -> UserId -> ByteString -> Rational -> Maybe Integer -> Nft +initNft :: TxOutRef -> UserId -> ByteString -> Ray -> Maybe Integer -> Nft initNft nftInRef author content share mPrice = Nft { nft'id = toNftId nftInRef content , nft'data = content diff --git a/mlabs/test/Test/Nft/Init.hs b/mlabs/test/Test/Nft/Init.hs index 29e92c911..8cd9e126a 100644 --- a/mlabs/test/Test/Nft/Init.hs +++ b/mlabs/test/Test/Nft/Init.hs @@ -44,7 +44,7 @@ import Control.Monad.Freer.Extras.Log import Control.Monad.Freer.Error import Plutus.Trace.Emulator -import qualified PlutusTx.Ratio as R +import qualified Mlabs.Data.Ray as R checkOptions :: CheckOptions checkOptions = defaultCheckOptions & emulatorConfig . Trace.initialChainState .~ Left initialDistribution From 7c0084d70c17baae3d33cea86f33f7583f70fe45 Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 31 May 2021 13:56:40 +0300 Subject: [PATCH 50/81] Add Pretty logger for PAB --- .../src/Mlabs/System/Console/PrettyLogger.hs | 83 +++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 mlabs/src/Mlabs/System/Console/PrettyLogger.hs diff --git a/mlabs/src/Mlabs/System/Console/PrettyLogger.hs b/mlabs/src/Mlabs/System/Console/PrettyLogger.hs new file mode 100644 index 000000000..0bae2bb86 --- /dev/null +++ b/mlabs/src/Mlabs/System/Console/PrettyLogger.hs @@ -0,0 +1,83 @@ +module Mlabs.System.Console.PrettyLogger + ( module Mlabs.System.Console.PrettyLogger + , module System.Console.ANSI + ) where + +import Control.Monad.IO.Class (MonadIO(..)) +import Prelude +import System.Console.ANSI + +------------------------------------------------------------------------------- + +data LogStyle = LogStyle + { bgColor :: LogColor + , color :: LogColor + , isBold :: Bool + } + +data LogColor + = Vibrant Color + | Standard Color + | DefaultColor + +defLogStyle :: LogStyle +defLogStyle = + LogStyle { bgColor = DefaultColor, color = DefaultColor, isBold = False } + +------------------------------------------------------------------------------- + +logPretty :: MonadIO m => String -> m () +logPretty = logPrettyStyled defLogStyle + +logPrettyStyled :: MonadIO m => LogStyle -> String -> m () +logPrettyStyled style string = liftIO $ do + setSGR + ( getColorList (color style) + <> getBgColorList (bgColor style) + <> getConsoleIntensityList (isBold style) + ) + putStr string + setSGR [Reset] + where + getColorList color = case color of + Vibrant x -> [SetColor Foreground Vivid x] + Standard x -> [SetColor Foreground Dull x] + _ -> [] + getBgColorList bgColor = case bgColor of + Vibrant x -> [SetColor Background Vivid x] + Standard x -> [SetColor Background Dull x] + _ -> [] + getConsoleIntensityList isBold = + if isBold then [SetConsoleIntensity BoldIntensity] else [] + +-- Convenience functions ------------------------------------------------------ + +logPrettyColor :: MonadIO m => LogColor -> String -> m () +logPrettyColor color = logPrettyStyled defLogStyle { color = color } + +logPrettyBgColor :: MonadIO m => Int -> LogColor -> LogColor -> String -> m () +logPrettyBgColor minWidth bgColor color str = logPrettyStyled + defLogStyle { bgColor = bgColor, color = color } + (padRight ' ' minWidth str) + +logPrettyColorBold :: MonadIO m => LogColor -> String -> m () +logPrettyColorBold color = + logPrettyStyled defLogStyle { color = color, isBold = True } + +withNewLines :: String -> String +withNewLines string = "\n" ++ string ++ "\n" + +logNewLine :: MonadIO m => m () +logNewLine = logPretty "\n" + +logDivider :: MonadIO m => m () +logDivider = + logPretty + $ "-----------------------------------------------------------" + ++ "\n" + +padLeft :: Char -> Int -> String -> String +padLeft char len txt = replicate (len - length txt) char <> txt + +padRight :: Char -> Int -> String -> String +padRight char len txt = txt <> replicate (len - length txt) char From e42142a774ba2378067a189de4fddc9c1a271593 Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 1 Jun 2021 16:50:07 +0300 Subject: [PATCH 51/81] Demo for NFT case --- mlabs/mlabs-plutus-use-cases.cabal | 3 +- mlabs/nft-demo/Main.hs | 176 ++++++++++++++++++++++++ mlabs/src/Mlabs/Data/Ray.hs | 2 +- mlabs/src/Mlabs/Nft/Contract/Nft.hs | 7 +- mlabs/src/Mlabs/Nft/Logic/Types.hs | 9 +- mlabs/src/Mlabs/System/Console/Utils.hs | 56 ++++++++ 6 files changed, 248 insertions(+), 5 deletions(-) create mode 100644 mlabs/nft-demo/Main.hs create mode 100644 mlabs/src/Mlabs/System/Console/Utils.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index fc6acc52f..2ce6dca2f 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -75,9 +75,9 @@ library Mlabs.Nft.Logic.Types Mlabs.Nft.Contract.Nft Mlabs.Nft.Contract.Forge - Mlabs.Nft.Contract.Pab Mlabs.Plutus.Contract.StateMachine Mlabs.System.Console.PrettyLogger + Mlabs.System.Console.Utils default-extensions: BangPatterns ExplicitForAll FlexibleContexts @@ -143,6 +143,7 @@ executable nft-demo , plutus-pab , prettyprinter , lens + , mtl , text , freer-extras , freer-simple diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs new file mode 100644 index 000000000..3e839f219 --- /dev/null +++ b/mlabs/nft-demo/Main.hs @@ -0,0 +1,176 @@ +-- | Simulator demo for NFTs +module Main where + +import Control.Monad.Reader + +import Prelude +import GHC.Generics + +import Control.Monad.Freer.Extras.Log (LogMsg) +import PlutusTx.Prelude (ByteString) +import Control.Monad.Freer (Eff, Member, interpret, type (~>)) +import Control.Monad.Freer.Error (Error) +import Data.Aeson (Result(..), fromJSON) +import Data.Row (type (.\\)) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) + +import Plutus.PAB.Effects.Contract (ContractEffect (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..)) +import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin +import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (..)) +import Plutus.PAB.Simulator (Simulation, SimulatorEffectHandlers) +import Plutus.PAB.Simulator qualified as Simulator +import Plutus.PAB.Types (PABError (..)) + +import Mlabs.Nft.Logic.Types +import qualified Mlabs.Nft.Contract.Nft as Nft +import qualified Mlabs.Data.Ray as R + +import Data.Text (Text) +import Playground.Contract + +import Plutus.Contract +import Data.Monoid (Last(..)) +import qualified Data.Text as T + +import qualified Plutus.PAB.Webserver.Server as PAB.Server +import Mlabs.System.Console.PrettyLogger +import Mlabs.System.Console.Utils + +import Wallet.Emulator.Wallet qualified as Wallet + +-- | Shortcut for Simulator monad for NFT case +type Sim a = Simulation (Builtin NftContracts) a + +-- | Main function to run simulator +main :: IO () +main = withSimulator handlers $ do + let users = [1, 2, 3] + logMlabs + test "Init users" users (pure ()) + + nid <- callStartNft user1 + cids <- mapM (callUser nid) [user1, user2, user3] + let [u1, u2, u3] = cids + + test "User 2 buys" [1, 2] $ do + setPrice u1 (Just 100) + buy u2 100 Nothing + + test "User 3 buys" [1, 2, 3] $ do + setPrice u2 (Just 500) + buy u3 500 (Just 1000) + where + withSimulator hs act = void $ Simulator.runSimulationWith hs $ do + Simulator.logString @(Builtin NftContracts) "Starting NFT PAB webserver. Press enter to exit." + shutdown <- PAB.Server.startServerDebug + void $ act + void $ liftIO getLine + shutdown + + printBalance n = logBalance ("WALLET " <> show n) =<< Simulator.valueAt (Wallet.walletAddress (Wallet n)) + + test msg wals act = do + void $ act + logAction msg + mapM_ printBalance wals + next + + next = do + logNewLine + void $ Simulator.waitNSlots 10 + +------------------------------------------------------------------------ +-- handlers + +-- | Instanciates start NFT endpoint in the simulator to the given wallet +callStartNft :: Wallet -> Sim NftId +callStartNft wal = do + wid <- Simulator.activateContract wal StartNft + nftId <- waitForLast wid + void $ Simulator.waitUntilFinished wid + pure nftId + +-- | Instanciates user actions endpoint in the simulator to the given wallet +callUser :: NftId -> Wallet -> Sim ContractInstanceId +callUser nid wal = do + Simulator.activateContract wal $ User nid + +-- | Waits for the given value to be written to the state of the service. +-- We use it to share data between endpoints. One endpoint can write parameter to state with tell +-- and in another endpoint we wait for the state-change. +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 + +-- | NFT schemas +data NftContracts + = StartNft -- ^ author can start NFT and provide NftId + | User NftId -- ^ we read NftId and instanciate schema for the user actions + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty NftContracts where + pretty = viaShow + +handleNftContracts :: + ( Member (Error PABError) effs + , Member (LogMsg (PABMultiAgentMsg (Builtin NftContracts))) effs + ) => + ContractEffect (Builtin NftContracts) + ~> Eff effs +handleNftContracts = Builtin.handleBuiltin getSchema getContract + where + getSchema = \case + StartNft -> Builtin.endpointsToSchemas @(Nft.AuthorSchema .\\ BlockchainActions) + User _ -> Builtin.endpointsToSchemas @(Nft.UserSchema .\\ BlockchainActions) + getContract = \case + StartNft -> SomeBuiltin startNftContract + User nid -> SomeBuiltin (Nft.userEndpoints nid) + +handlers :: SimulatorEffectHandlers (Builtin NftContracts) +handlers = + Simulator.mkSimulatorHandlers @(Builtin NftContracts) [] + $ interpret handleNftContracts + +startNftContract :: Contract (Last NftId) Nft.AuthorSchema Text () +startNftContract = mapError (T.pack . show) $ Nft.startNft startParams + +------------------------------------------------------------- +-- Script helpers + +-- | Call buy NFT endpoint +buy :: ContractInstanceId -> Integer -> Maybe Integer -> Sim () +buy cid price newPrice = do + void $ Simulator.callEndpointOnInstance cid "buy-act" (Nft.BuyAct price newPrice) + void $ Simulator.waitNSlots 1 + +-- | Call set price for NFT endpoint +setPrice :: ContractInstanceId -> Maybe Integer -> Sim () +setPrice cid newPrice = do + void $ Simulator.callEndpointOnInstance cid "set-price-act" (Nft.SetPriceAct newPrice) + void $ Simulator.waitNSlots 1 + +------------------------------------------------------------- +-- constants + +-- Users for testing +user1, user2, user3 :: Wallet +user1 = Wallet 1 +user2 = Wallet 2 +user3 = Wallet 3 + +-- | Content of NFT +nftContent :: ByteString +nftContent = "Mona Lisa" + +-- | NFT initial parameters +startParams :: Nft.StartParams +startParams = Nft.StartParams + { sp'content = nftContent + , sp'share = 1 R.% 10 + , sp'price = Nothing + } + diff --git a/mlabs/src/Mlabs/Data/Ray.hs b/mlabs/src/Mlabs/Data/Ray.hs index 4b73dd693..24454e90e 100644 --- a/mlabs/src/Mlabs/Data/Ray.hs +++ b/mlabs/src/Mlabs/Data/Ray.hs @@ -31,7 +31,7 @@ import Playground.Contract (ToSchema) import qualified PlutusTx.Ratio as R {-# INLINABLE base #-} --- | Base precision +-- | Base precision (27 precision digits are allowed) base :: Integer base = 1_000_000_000_000_000_000_000_000_000 diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs index ad8b8e130..5465cca15 100644 --- a/mlabs/src/Mlabs/Nft/Contract/Nft.hs +++ b/mlabs/src/Mlabs/Nft/Contract/Nft.hs @@ -11,6 +11,8 @@ module Mlabs.Nft.Contract.Nft( , AuthorSchema , startNft , userEndpoints + , BuyAct(..) + , SetPriceAct(..) ) where import qualified Prelude as P @@ -148,6 +150,7 @@ type UserSchema = .\/ Endpoint "buy-act" BuyAct .\/ Endpoint "set-price-act" SetPriceAct +-- | User buys NFT data BuyAct = BuyAct { buy'price :: Integer , buy'newPrice :: Maybe Integer @@ -155,6 +158,7 @@ data BuyAct = BuyAct deriving stock (Show, Generic, P.Eq) deriving anyclass (FromJSON, ToJSON, ToSchema) +-- | User sets new price for NFT data SetPriceAct = SetPriceAct { setPrice'newPrice :: Maybe Integer } @@ -210,7 +214,7 @@ data StartParams = StartParams , sp'price :: Maybe Integer -- ^ current price of NFT, if it's nothing then nobody can buy it. } deriving stock (Show, Generic) - deriving anyclass (FromJSON, ToJSON) + deriving anyclass (FromJSON, ToJSON, ToSchema) -- | Contract for the author of NFT type AuthorContract a = Contract (Last NftId) AuthorSchema NftError a @@ -264,3 +268,4 @@ callStartNft wal sp = do where err = F.throwError $ Trace.GenericError "No NFT started in emulator" + diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index 6b7043308..439337eff 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -5,6 +5,7 @@ {-# OPTIONS_GHC -fobject-code #-} {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Datatypes for NFT state machine. module Mlabs.Nft.Logic.Types( Nft(..) @@ -22,7 +23,8 @@ import qualified PlutusTx as PlutusTx import PlutusTx.Prelude import Plutus.V1.Ledger.Value (TokenName(..), tokenName) import GHC.Generics -import Playground.Contract (TxOutRef) +import Playground.Contract (TxOutRef, ToSchema) +import Plutus.V1.Ledger.TxId import Mlabs.Emulator.Types (UserId(..)) import Mlabs.Data.Ray (Ray) @@ -46,7 +48,10 @@ data NftId = NftId -- with it we can guarantee unqiqueness of NFT } deriving stock (Show, Generic, Hask.Eq) - deriving anyclass (FromJSON, ToJSON) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +deriving newtype instance ToSchema TxId +deriving instance ToSchema TxOutRef instance Eq NftId where {-# INLINABLE (==) #-} diff --git a/mlabs/src/Mlabs/System/Console/Utils.hs b/mlabs/src/Mlabs/System/Console/Utils.hs new file mode 100644 index 000000000..20d9635b6 --- /dev/null +++ b/mlabs/src/Mlabs/System/Console/Utils.hs @@ -0,0 +1,56 @@ +module Mlabs.System.Console.Utils( + logAsciiLogo + , logAction + , logBalance + , logMlabs +) where + +import Control.Monad.IO.Class + +import Prelude +import qualified Plutus.V1.Ledger.Value as Value +import qualified Data.ByteString.Char8 as Char8 + +import Mlabs.System.Console.PrettyLogger + + +logMlabs :: MonadIO m => m () +logMlabs = logAsciiLogo (Vibrant Red) mlabs + +mlabs :: String +mlabs = + " \n\ + \ ███╗ ███╗ ██╗ █████╗ ██████╗ ███████╗ \n\ + \ ████╗ ████║ ██║ ██╔══██╗██╔══██╗██╔════╝ \n\ + \ ██╔████╔██║ ██║ ███████║██████╔╝███████╗ \n\ + \ ██║╚██╔╝██║ ██║ ██╔══██║██╔══██╗╚════██║ \n\ + \ ██║ ╚═╝ ██║ ███████╗██║ ██║██████╔╝███████║ \n\ + \ ╚═╝ ╚═╝ ╚══════╝╚═╝ ╚═╝╚═════╝ ╚══════╝ " + +logAsciiLogo :: MonadIO m => LogColor -> String -> m () +logAsciiLogo color logo = do + logNewLine + logPrettyBgColor 40 color (Standard Black) logo + logNewLine + +logAction :: MonadIO m => String -> m () +logAction str = logPrettyColorBold (Vibrant Green) (withNewLines $ str) + +logBalance :: MonadIO m => String -> Value.Value -> m () +logBalance wallet val = do + logNewLine + logPrettyBgColor 40 (Vibrant Cyan) (Standard Black) (wallet ++ " BALANCE") + logNewLine + logPrettyColor (Vibrant Cyan) (formatValue val) + logNewLine + +formatValue :: Value.Value -> String +formatValue v = + unlines $ fmap formatTokenValue $ + filter ((/= 0) . (\(_,_,n) -> n)) $ Value.flattenValue v + where + formatTokenValue (_, name, value) = + case name of + "" -> (padRight ' ' 7 "Ada") ++ " " ++ (show value) + (Value.TokenName n) -> (padRight ' ' 7 $ Char8.unpack n) ++ " " ++ (show value) + From 0d466e5acdaefae97289a1ebe2961bdcb4658b3e Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 1 Jun 2021 17:05:55 +0300 Subject: [PATCH 52/81] Init lendex demo stub --- mlabs/lendex-demo/Main.hs | 88 ++++++++++++++++++++++++++++++ mlabs/mlabs-plutus-use-cases.cabal | 33 +++++++++++ mlabs/nft-demo/Main.hs | 4 +- 3 files changed, 123 insertions(+), 2 deletions(-) create mode 100644 mlabs/lendex-demo/Main.hs diff --git a/mlabs/lendex-demo/Main.hs b/mlabs/lendex-demo/Main.hs new file mode 100644 index 000000000..b3ef9b8a6 --- /dev/null +++ b/mlabs/lendex-demo/Main.hs @@ -0,0 +1,88 @@ +-- | Console demo for Lendex +module Main where + +import Prelude +import GHC.Generics + +import Control.Monad.IO.Class +import Data.Functor +import Control.Monad.Freer.Extras.Log (LogMsg) +import PlutusTx.Prelude (ByteString) +import Control.Monad.Freer (Eff, Member, interpret, type (~>)) +import Control.Monad.Freer.Error (Error) +import Data.Aeson (Result(..), fromJSON) +import Data.Row (type (.\\)) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) + +import Plutus.PAB.Effects.Contract (ContractEffect (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..)) +import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin +import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (..)) +import Plutus.PAB.Simulator (Simulation, SimulatorEffectHandlers) +import Plutus.PAB.Simulator qualified as Simulator +import Plutus.PAB.Types (PABError (..)) + +import Mlabs.Lending.Logic.Types +import qualified Mlabs.Lending.Contract.Lendex as Lending +import qualified Mlabs.Data.Ray as R + +import Data.Text (Text) +import Playground.Contract + +import Plutus.Contract +import Data.Monoid (Last(..)) +import qualified Data.Text as T + +import qualified Plutus.PAB.Webserver.Server as PAB.Server +import Mlabs.System.Console.PrettyLogger +import Mlabs.System.Console.Utils + +import Wallet.Emulator.Wallet qualified as Wallet + +-- | Shortcut for Simulator monad for NFT case +type Sim a = Simulation (Builtin LendexContracts) a + +-- | Lendex schemas +data LendexContracts + = Init -- ^ init wallets + | StartLendex -- ^ admin of the platform can start Lendex and provide LendexId + | User LendexId -- ^ we read Lendex identifier and instanciate schema for the user actions + | PriceOracle LendexId -- ^ price oracle actions + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty LendexContracts where + pretty = viaShow + +-- | Console demo for Lendex with simulator +main :: IO () +main = withSimulator handlers $ do + liftIO $ print "Hi Lendex!" + where + withSimulator hs act = void $ Simulator.runSimulationWith hs $ do + Simulator.logString @(Builtin LendexContracts) "Starting Lendex PAB webserver. Press enter to exit." + shutdown <- PAB.Server.startServerDebug + void $ act + void $ liftIO getLine + shutdown + +handleLendexContracts :: + ( Member (Error PABError) effs + , Member (LogMsg (PABMultiAgentMsg (Builtin LendexContracts))) effs + ) => + ContractEffect (Builtin LendexContracts) + ~> Eff effs +handleLendexContracts = Builtin.handleBuiltin getSchema getContract + where + getSchema = undefined + getContract = undefined + +handlers :: SimulatorEffectHandlers (Builtin LendexContracts) +handlers = + Simulator.mkSimulatorHandlers @(Builtin LendexContracts) [] + $ interpret handleLendexContracts + + + + + diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 2ce6dca2f..ad139efe5 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -160,6 +160,39 @@ executable nft-demo default-language: Haskell2010 default-extensions: AllowAmbiguousTypes BlockArguments BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase ExplicitNamespaces FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns ImportQualifiedPost RoleAnnotations +executable lendex-demo + main-is: lendex-demo/Main.hs + build-depends: base >=4.14 && <4.15 + , aeson + , bytestring + , containers + , playground-common + , plutus-core + , plutus-contract + , plutus-ledger + , plutus-ledger-api + , plutus-tx + , plutus-tx-plugin + , plutus-pab + , prettyprinter + , lens + , mtl + , text + , freer-extras + , freer-simple + , mlabs-plutus-use-cases + , ansi-terminal + , bytestring + , cardano-prelude + , data-default-class + , lens + , playground-common + , prettyprinter + , row-types + , vector + default-language: Haskell2010 + default-extensions: AllowAmbiguousTypes BlockArguments BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase ExplicitNamespaces FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns ImportQualifiedPost RoleAnnotations + Test-suite mlabs-plutus-use-cases-tests Type: exitcode-stdio-1.0 diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index 3e839f219..a0b250167 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -1,11 +1,11 @@ -- | Simulator demo for NFTs module Main where -import Control.Monad.Reader - import Prelude import GHC.Generics +import Control.Monad.IO.Class +import Data.Functor import Control.Monad.Freer.Extras.Log (LogMsg) import PlutusTx.Prelude (ByteString) import Control.Monad.Freer (Eff, Member, interpret, type (~>)) From ee0b06888a64075db179a0161bb2578f8b1b2ec1 Mon Sep 17 00:00:00 2001 From: anton-k Date: Tue, 1 Jun 2021 17:19:53 +0300 Subject: [PATCH 53/81] switch to Rays instead of Rationals for Lendex --- mlabs/src/Mlabs/Control/Check.hs | 16 ++++++++ mlabs/src/Mlabs/Lending/Logic/App.hs | 5 ++- mlabs/src/Mlabs/Lending/Logic/InterestRate.hs | 21 +++++----- mlabs/src/Mlabs/Lending/Logic/React.hs | 16 ++++---- mlabs/src/Mlabs/Lending/Logic/State.hs | 13 ++++--- mlabs/src/Mlabs/Lending/Logic/Types.hs | 39 ++++++++++--------- mlabs/test/Test/Lending/Contract.hs | 3 +- mlabs/test/Test/Lending/Logic.hs | 3 +- 8 files changed, 69 insertions(+), 47 deletions(-) diff --git a/mlabs/src/Mlabs/Control/Check.hs b/mlabs/src/Mlabs/Control/Check.hs index 18c75ec3c..ac2b49273 100644 --- a/mlabs/src/Mlabs/Control/Check.hs +++ b/mlabs/src/Mlabs/Control/Check.hs @@ -4,12 +4,16 @@ module Mlabs.Control.Check( , isPositive , isPositiveRational , isUnitRange + , isPositiveRay + , isUnitRangeRay ) where import Control.Monad.Except (MonadError(..)) import PlutusTx.Prelude import qualified PlutusTx.Ratio as R +import Mlabs.Data.Ray (Ray) +import qualified Mlabs.Data.Ray as Ray {-# INLINABLE isNonNegative #-} isNonNegative :: (Applicative m, MonadError String m) => String -> Integer -> m () @@ -35,3 +39,15 @@ isUnitRange msg val | val >= R.fromInteger 0 && val <= R.fromInteger 1 = pure () | otherwise = throwError $ msg <> " should have unit range [0, 1]" +{-# INLINABLE isPositiveRay #-} +isPositiveRay :: (Applicative m, MonadError String m) => String -> Ray -> m () +isPositiveRay msg val + | val > Ray.fromInteger 0 = pure () + | otherwise = throwError $ msg <> " should be positive" + +{-# INLINABLE isUnitRangeRay #-} +isUnitRangeRay :: (Applicative m, MonadError String m) => String -> Ray -> m () +isUnitRangeRay msg val + | val >= Ray.fromInteger 0 && val <= Ray.fromInteger 1 = pure () + | otherwise = throwError $ msg <> " should have unit range [0, 1]" + diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index 391148e86..fcc2f4b2a 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -14,7 +14,7 @@ module Mlabs.Lending.Logic.App( , governAct ) where -import PlutusTx.Prelude +import PlutusTx.Prelude hiding ((%)) import Plutus.V1.Ledger.Value import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) @@ -27,7 +27,8 @@ import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M import qualified PlutusTx.AssocMap as AM -import qualified PlutusTx.Ratio as R +import Mlabs.Data.Ray ((%)) +import qualified Mlabs.Data.Ray as R type LendingApp = App LendingPool Act diff --git a/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs b/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs index a376430ca..c108044a7 100644 --- a/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs +++ b/mlabs/src/Mlabs/Lending/Logic/InterestRate.hs @@ -9,7 +9,8 @@ module Mlabs.Lending.Logic.InterestRate( ) where import PlutusTx.Prelude -import qualified PlutusTx.Ratio as R +import Mlabs.Data.Ray (Ray) +import qualified Mlabs.Data.Ray as R import Mlabs.Lending.Logic.Types @@ -29,37 +30,37 @@ updateReserveInterestRates currentTime reserve = reserve { reserve'interest = ne lastUpdateTime = ri'lastUpdateTime reserve'interest {-# INLINABLE getYearDelta #-} -getYearDelta :: Integer -> Integer -> Rational +getYearDelta :: Integer -> Integer -> Ray getYearDelta t0 t1 = R.fromInteger (max 0 $ t1 - t0) * secondsPerSlot * R.recip secondsPerYear where secondsPerSlot = R.fromInteger 1 secondsPerYear = R.fromInteger 31622400 {-# INLINABLE getCumulatedLiquidityIndex #-} -getCumulatedLiquidityIndex :: Rational -> Rational -> Rational -> Rational +getCumulatedLiquidityIndex :: Ray -> Ray -> Ray -> Ray getCumulatedLiquidityIndex liquidityRate yearDelta prevLiquidityIndex = (liquidityRate * yearDelta + R.fromInteger 1) * prevLiquidityIndex {-# INLINABLE getNormalisedIncome #-} -getNormalisedIncome :: Rational -> Rational -> Rational -> Rational +getNormalisedIncome :: Ray -> Ray -> Ray -> Ray getNormalisedIncome liquidityRate yearDelta prevLiquidityIndex = (liquidityRate * yearDelta + R.fromInteger 1) * prevLiquidityIndex {-# INLINABLE getLiquidityRate #-} -getLiquidityRate :: Reserve -> Rational +getLiquidityRate :: Reserve -> Ray getLiquidityRate Reserve{..} = r * u where u = getUtilisation reserve'wallet r = getBorrowRate (ri'interestModel reserve'interest) u {-# INLINABLE getUtilisation #-} -getUtilisation :: Wallet -> Rational -getUtilisation Wallet{..} = wallet'borrow % liquidity +getUtilisation :: Wallet -> Ray +getUtilisation Wallet{..} = wallet'borrow R.% liquidity where liquidity = wallet'deposit + wallet'borrow {-# INLINABLE getBorrowRate #-} -getBorrowRate :: InterestModel -> Rational -> Rational +getBorrowRate :: InterestModel -> Ray -> Ray getBorrowRate InterestModel{..} u | u <= uOptimal = im'base + im'slope1 * (u * R.recip uOptimal) | otherwise = im'base + im'slope2 * (u - uOptimal) * R.recip (R.fromInteger 1 - uOptimal) @@ -67,7 +68,7 @@ getBorrowRate InterestModel{..} u uOptimal = im'optimalUtilisation {-# INLINABLE addDeposit #-} -addDeposit :: Rational -> Integer -> Wallet -> Either String Wallet +addDeposit :: Ray -> Integer -> Wallet -> Either String Wallet addDeposit normalisedIncome amount wal | newDeposit >= 0 = Right wal { wallet'deposit = max 0 newDeposit @@ -78,7 +79,7 @@ addDeposit normalisedIncome amount wal newDeposit = wallet'deposit wal + amount {-# INLINABLE getCumulativeBalance #-} -getCumulativeBalance :: Rational -> Wallet -> Rational +getCumulativeBalance :: Ray -> Wallet -> Ray getCumulativeBalance normalisedIncome Wallet{..} = wallet'scaledBalance * normalisedIncome diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index abab3b673..84c53cae9 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -12,7 +12,6 @@ module Mlabs.Lending.Logic.React( import qualified Prelude as Hask -import qualified PlutusTx.Ratio as R import qualified PlutusTx.Numeric as N import PlutusTx.Prelude import qualified PlutusTx.AssocMap as M @@ -21,6 +20,7 @@ import qualified PlutusTx.These as PlutusTx import Control.Monad.Except hiding (Functor(..), mapM) import Control.Monad.State.Strict hiding (Functor(..), mapM) +import qualified Mlabs.Data.Ray as R import Mlabs.Control.Check import Mlabs.Emulator.Blockchain import Mlabs.Lending.Logic.InterestRate (addDeposit) @@ -345,7 +345,7 @@ checkInput = \case SwapBorrowRateModelAct asset _rate -> isAsset asset SetUserReserveAsCollateralAct asset _useAsCollateral portion -> do isAsset asset - isUnitRange "deposit portion" portion + isUnitRangeRay "deposit portion" portion WithdrawAct amount asset -> do isPositive "withdraw" amount isAsset asset @@ -359,21 +359,21 @@ checkInput = \case case act of SetAssetPrice asset price -> do checkCoinRateTimeProgress time asset - isPositiveRational "price" price + isPositiveRay "price" price isAsset asset checkGovernAct = \case AddReserve cfg -> checkCoinCfg cfg checkCoinCfg CoinCfg{..} = do - isPositiveRational "coin price config" coinCfg'rate + isPositiveRay "coin price config" coinCfg'rate checkInterestModel coinCfg'interestModel - isUnitRange "liquidation bonus config" coinCfg'liquidationBonus + isUnitRangeRay "liquidation bonus config" coinCfg'liquidationBonus checkInterestModel InterestModel{..} = do - isUnitRange "optimal utilisation" im'optimalUtilisation - isPositiveRational "slope 1" im'slope1 - isPositiveRational "slope 2" im'slope2 + isUnitRangeRay "optimal utilisation" im'optimalUtilisation + isPositiveRay "slope 1" im'slope1 + isPositiveRay "slope 2" im'slope2 checkCoinRateTimeProgress time asset = do lastUpdateTime <- coinRate'lastUpdateTime . reserve'rate <$> getReserve asset diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 6b4dc9664..2488cac41 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -46,7 +46,6 @@ module Mlabs.Lending.Logic.State( , getCumulativeBalance ) where -import qualified PlutusTx.Ratio as R import qualified PlutusTx.Numeric as N import PlutusTx.Prelude import PlutusTx.AssocMap (Map) @@ -59,6 +58,8 @@ import qualified Mlabs.Lending.Logic.InterestRate as IR import Mlabs.Lending.Logic.Types import Mlabs.Control.Monad.State +import Mlabs.Data.Ray (Ray) +import qualified Mlabs.Data.Ray as R -- | Type for errors type Error = String @@ -199,7 +200,7 @@ getHealthCheck addToBorrow coin user = {-# INLINABLE getHealth #-} -- | Check borrowing health for the user by given currency -getHealth :: Integer -> Coin -> User -> St Rational +getHealth :: Integer -> Coin -> User -> St Ray getHealth addToBorrow coin user = do col <- getTotalCollateral user bor <- fmap (+ addToBorrow) $ getTotalBorrow user @@ -208,13 +209,13 @@ getHealth addToBorrow coin user = do {-# INLINABLE getLiquidationThreshold #-} -- | Reads liquidation threshold for a give asset. -getLiquidationThreshold :: Coin -> St Rational +getLiquidationThreshold :: Coin -> St Ray getLiquidationThreshold coin = gets (maybe (R.fromInteger 0) reserve'liquidationThreshold . M.lookup coin . lp'reserves) {-# INLINABLE getLiquidationBonus #-} -- | Reads liquidation bonus for a give asset. -getLiquidationBonus :: Coin -> St Rational +getLiquidationBonus :: Coin -> St Ray getLiquidationBonus coin = gets (maybe (R.fromInteger 0) reserve'liquidationBonus . M.lookup coin . lp'reserves) @@ -291,12 +292,12 @@ modifyWallet' uid coin f = modifyUser' uid $ \(User ws time health) -> do pure $ User (M.insert coin wal ws) time health {-# INLINABLE getNormalisedIncome #-} -getNormalisedIncome :: Coin -> St Rational +getNormalisedIncome :: Coin -> St Ray getNormalisedIncome asset = getsReserve asset $ (ri'normalisedIncome . reserve'interest) {-# INLINABLE getCumulativeBalance #-} -getCumulativeBalance :: UserId -> Coin -> St Rational +getCumulativeBalance :: UserId -> Coin -> St Ray getCumulativeBalance uid asset = do ni <- getNormalisedIncome asset getsWallet uid asset (IR.getCumulativeBalance ni) diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index c3779d133..649b7bb5d 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -43,16 +43,17 @@ module Mlabs.Lending.Logic.Types( import Data.Aeson (FromJSON, ToJSON) -import qualified PlutusTx.Ratio as R import qualified Prelude as Hask import qualified PlutusTx as PlutusTx -import PlutusTx.Prelude +import PlutusTx.Prelude hiding ((%)) import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) import PlutusTx.AssocMap (Map) import qualified PlutusTx.AssocMap as M import GHC.Generics import Mlabs.Emulator.Types +import Mlabs.Data.Ray (Ray, (%)) +import qualified Mlabs.Data.Ray as R -- | Unique identifier of the lending pool state. newtype LendexId = LendexId ByteString @@ -76,14 +77,14 @@ data LendingPool = LendingPool data Reserve = Reserve { reserve'wallet :: !Wallet -- ^ total amounts of coins deposited to reserve , reserve'rate :: !CoinRate -- ^ ratio of reserve's coin to base currency - , reserve'liquidationThreshold :: !Rational -- ^ ratio at which liquidation of collaterals can happen for this coin - , reserve'liquidationBonus :: !Rational -- ^ ratio of bonus for liquidation of the borrow in collateral of this asset + , reserve'liquidationThreshold :: !Ray -- ^ ratio at which liquidation of collaterals can happen for this coin + , reserve'liquidationBonus :: !Ray -- ^ ratio of bonus for liquidation of the borrow in collateral of this asset , reserve'aToken :: !TokenName -- ^ aToken corresponding to the coin of the reserve , reserve'interest :: !ReserveInterest -- ^ reserve liquidity params } deriving (Show, Generic) -type HealthReport = Map BadBorrow Rational +type HealthReport = Map BadBorrow Ray -- | Borrow that don't has enough collateral. -- It has health check ration below one. @@ -100,7 +101,7 @@ instance Eq BadBorrow where -- | Price of the given currency to Ada. data CoinRate = CoinRate - { coinRate'value :: !Rational -- ^ ratio to ada + { coinRate'value :: !Ray -- ^ ratio to ada , coinRate'lastUpdateTime :: !Integer -- ^ last time price was updated } deriving (Show, Generic) @@ -108,18 +109,18 @@ data CoinRate = CoinRate -- | Parameters for calculation of interest rates. data ReserveInterest = ReserveInterest { ri'interestModel :: !InterestModel - , ri'liquidityRate :: !Rational - , ri'liquidityIndex :: !Rational - , ri'normalisedIncome :: !Rational + , ri'liquidityRate :: !Ray + , ri'liquidityIndex :: !Ray + , ri'normalisedIncome :: !Ray , ri'lastUpdateTime :: !Integer } deriving (Show, Generic) data InterestModel = InterestModel - { im'optimalUtilisation :: !Rational - , im'slope1 :: !Rational - , im'slope2 :: !Rational - , im'base :: !Rational + { im'optimalUtilisation :: !Ray + , im'slope1 :: !Ray + , im'slope2 :: !Ray + , im'base :: !Ray } deriving (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) @@ -135,10 +136,10 @@ defaultInterestModel = InterestModel -- | Coin configuration data CoinCfg = CoinCfg { coinCfg'coin :: Coin - , coinCfg'rate :: Rational + , coinCfg'rate :: Ray , coinCfg'aToken :: TokenName , coinCfg'interestModel :: InterestModel - , coinCfg'liquidationBonus :: Rational + , coinCfg'liquidationBonus :: Ray } deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) @@ -195,7 +196,7 @@ data User = User deriving (Show, Generic) -- | Health ratio for user per borrow -type Health = Map Coin Rational +type Health = Map Coin Ray {-# INLINABLE defaultUser #-} -- | Default user with no wallets. @@ -213,7 +214,7 @@ data Wallet = Wallet { wallet'deposit :: !Integer -- ^ amount of deposit , wallet'collateral :: !Integer -- ^ amount of collateral , wallet'borrow :: !Integer -- ^ amount of borrow - , wallet'scaledBalance :: !Rational -- ^ scaled balance + , wallet'scaledBalance :: !Ray -- ^ scaled balance } deriving (Show, Generic) @@ -265,7 +266,7 @@ data UserAct | SetUserReserveAsCollateralAct { act'asset :: Coin -- ^ which asset to use as collateral or not , act'useAsCollateral :: Bool -- ^ should we use as collateral (True) or use as deposit (False) - , act'portion :: Rational -- ^ poriton of deposit/collateral to change status (0, 1) + , act'portion :: Ray -- ^ poriton of deposit/collateral to change status (0, 1) } -- ^ set some portion of deposit as collateral or some portion of collateral as deposit | WithdrawAct @@ -296,7 +297,7 @@ data GovernAct -- | Updates for the prices of the currencies on the markets data PriceAct - = SetAssetPrice Coin Rational -- ^ Set asset price + = SetAssetPrice Coin Ray -- ^ Set asset price deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 281e30f80..2f6215734 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -9,7 +9,8 @@ import Test.Tasty import Plutus.Contract.Test hiding (tx) import qualified Plutus.Trace.Emulator as Trace -import qualified PlutusTx.Ratio as R + +import qualified Mlabs.Data.Ray as R import Mlabs.Emulator.Scene import Mlabs.Lending.Logic.Types ( UserAct(..), InterestRate(..), CoinCfg(..), defaultInterestModel diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index e11b23f28..21a3ca09a 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -17,7 +17,8 @@ import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M -import qualified PlutusTx.Ratio as R +import Mlabs.Data.Ray ((%)) +import qualified Mlabs.Data.Ray as R -- | Test suite for a logic of lending application test :: TestTree From 6cf62eef9e210499c29e5fd6375f5a912da81799 Mon Sep 17 00:00:00 2001 From: anton-k Date: Wed, 2 Jun 2021 11:58:03 +0300 Subject: [PATCH 54/81] Introduce admin roles for Lendex and check for them --- mlabs/src/Mlabs/Emulator/Types.hs | 8 ++++++ mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 7 +++-- mlabs/src/Mlabs/Lending/Logic/App.hs | 13 ++++++--- mlabs/src/Mlabs/Lending/Logic/React.hs | 20 ++++++++------ mlabs/src/Mlabs/Lending/Logic/State.hs | 32 ++++++++++++++++------ mlabs/src/Mlabs/Lending/Logic/Types.hs | 11 ++++++-- mlabs/src/Mlabs/Nft/Contract/Nft.hs | 6 +--- mlabs/test/Test/Lending/Contract.hs | 1 + mlabs/test/Test/Lending/Logic.hs | 3 +- 9 files changed, 68 insertions(+), 33 deletions(-) diff --git a/mlabs/src/Mlabs/Emulator/Types.hs b/mlabs/src/Mlabs/Emulator/Types.hs index 4c47da7e1..e714ed2b9 100644 --- a/mlabs/src/Mlabs/Emulator/Types.hs +++ b/mlabs/src/Mlabs/Emulator/Types.hs @@ -9,6 +9,7 @@ module Mlabs.Emulator.Types( UserId(..) , Coin , adaCoin + , ownUserId ) where import Data.Aeson (FromJSON, ToJSON) @@ -21,6 +22,9 @@ import Plutus.V1.Ledger.Value (AssetClass(..)) import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) import qualified PlutusTx as PlutusTx +import Plutus.Contract (HasBlockchainActions, AsContractError, Contract, ownPubKey) +import Plutus.V1.Ledger.Contexts (pubKeyHash) + -- | Address of the wallet that can hold values of assets data UserId = UserId PubKeyHash -- user address @@ -43,3 +47,7 @@ adaCoin = AssetClass (Ada.adaSymbol, Ada.adaToken) type Coin = AssetClass PlutusTx.unstableMakeIsData ''UserId + +-- | Get user id of the wallet owner. +ownUserId :: (AsContractError e, HasBlockchainActions s) => Contract w s e UserId +ownUserId = fmap (UserId . pubKeyHash) ownPubKey diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs index 1c0186190..b2c286d61 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs @@ -42,6 +42,7 @@ import PlutusTx.Prelude hiding (Applicative (..), check, S import qualified PlutusTx.Prelude as Plutus import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Types import Mlabs.Lending.Logic.React import Mlabs.Lending.Logic.Types import qualified Mlabs.Lending.Contract.Forge as Forge @@ -184,6 +185,7 @@ type GovernLendexSchema = data StartParams = StartParams { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA , sp'initValue :: Value -- ^ init value deposited to the lending app + , sp'admins :: [UserId] -- ^ admins , sp'oracles :: [UserId] -- ^ trusted oracles } deriving stock (Show, Generic) @@ -193,11 +195,12 @@ type GovernApp a = Contract () GovernLendexSchema LendexError a governAction :: LendexId -> GovernAct -> GovernApp () governAction lid act = do - void $ SM.runStep (client lid) (GovernAct act) + uid <- ownUserId + void $ SM.runStep (client lid) (GovernAct uid act) startLendex :: LendexId -> StartParams -> GovernApp () startLendex lid StartParams{..} = do - void $ SM.runInitialise (client lid) (lid, initLendingPool (Forge.currencySymbol lid) sp'coins sp'oracles) sp'initValue + void $ SM.runInitialise (client lid) (lid, initLendingPool (Forge.currencySymbol lid) sp'coins sp'admins sp'oracles) sp'initValue -- | Endpoints for admin user governEndpoints :: LendexId -> GovernApp () diff --git a/mlabs/src/Mlabs/Lending/Logic/App.hs b/mlabs/src/Mlabs/Lending/Logic/App.hs index fcc2f4b2a..a6058609b 100644 --- a/mlabs/src/Mlabs/Lending/Logic/App.hs +++ b/mlabs/src/Mlabs/Lending/Logic/App.hs @@ -45,6 +45,8 @@ data AppConfig = AppConfig -- no need to include it here , appConfig'currencySymbol :: CurrencySymbol -- ^ lending app main currency symbol + , appConfig'admins :: [UserId] + -- ^ users that can do govern actions , appConfig'oracles :: [UserId] -- ^ users that can submit price changes } @@ -58,6 +60,7 @@ initApp AppConfig{..} = App , lp'currency = appConfig'currencySymbol , lp'coinMap = coinMap , lp'healthReport = AM.empty + , lp'admins = appConfig'admins , lp'trustedOracles = appConfig'oracles } , app'log = [] @@ -70,9 +73,11 @@ initApp AppConfig{..} = App -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. defaultAppConfig :: AppConfig -defaultAppConfig = AppConfig reserves users curSym oracles +defaultAppConfig = AppConfig reserves users curSym admins oracles where - oracles = [UserId $ PubKeyHash "1"] -- only user 1 can set the price + admins = [user1] + oracles = [user1] + user1 = UserId $ PubKeyHash "1" -- only user 1 can set the price and be admin curSym = currencySymbol "lending-app" userNames = ["1", "2", "3"] coinNames = ["Dollar", "Euro", "Lira"] @@ -112,6 +117,6 @@ priceAct uid arg = do S.putAct $ PriceAct t uid arg -- | Make govern act -governAct :: GovernAct -> Script -governAct arg = S.putAct $ GovernAct arg +governAct :: UserId -> GovernAct -> Script +governAct uid arg = S.putAct $ GovernAct uid arg diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 84c53cae9..7feda0e88 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -40,7 +40,7 @@ react input = do case input of UserAct t uid act -> withHealthCheck t $ userAct t uid act PriceAct t uid act -> withHealthCheck t $ priceAct t uid act - GovernAct act -> governAct act + GovernAct uid act -> governAct uid act where -- | User acts userAct time uid = \case @@ -262,20 +262,22 @@ react input = do --------------------------------------------------- -- Govern acts - governAct = \case - AddReserve cfg -> addReserve cfg + governAct uid act = do + isAdmin uid + case act of + AddReserve cfg -> addReserve cfg --------------------------------------------------- -- Adds new reserve (new coin/asset) addReserve cfg@CoinCfg{..} = do - LendingPool reserves users curSym coinMap healthReport oracles <- get - if M.member coinCfg'coin reserves + st <- get + if M.member coinCfg'coin (lp'reserves st) then throwError "Reserve is already present" else do - let newReserves = M.insert coinCfg'coin (initReserve cfg) reserves - newCoinMap = M.insert coinCfg'aToken coinCfg'coin coinMap - put $ LendingPool newReserves users curSym newCoinMap healthReport oracles + let newReserves = M.insert coinCfg'coin (initReserve cfg) $ lp'reserves st + newCoinMap = M.insert coinCfg'aToken coinCfg'coin $ lp'coinMap st + put $ st { lp'reserves = newReserves, lp'coinMap = newCoinMap } return [] --------------------------------------------------- @@ -330,7 +332,7 @@ checkInput = \case isNonNegative "timestamp" time checkUserAct act PriceAct time _uid act -> checkPriceAct time act - GovernAct act -> checkGovernAct act + GovernAct _uid act -> checkGovernAct act where checkUserAct = \case DepositAct amount asset -> do diff --git a/mlabs/src/Mlabs/Lending/Logic/State.hs b/mlabs/src/Mlabs/Lending/Logic/State.hs index 2488cac41..f5ce661eb 100644 --- a/mlabs/src/Mlabs/Lending/Logic/State.hs +++ b/mlabs/src/Mlabs/Lending/Logic/State.hs @@ -11,6 +11,7 @@ module Mlabs.Lending.Logic.State( , Error , isAsset , aToken + , isAdmin , isTrustedOracle , updateReserveState , initReserve @@ -71,6 +72,7 @@ type St = PlutusState LendingPool -- common functions {-# INLINABLE isAsset #-} +-- | Check that lending pool supports given asset isAsset :: Coin -> St () isAsset asset = do reserves <- gets lp'reserves @@ -79,15 +81,27 @@ isAsset asset = do else throwError "Asset not supported" {-# INLINABLE updateReserveState #-} +-- | Updates all iterative parameters of reserve. +-- Reserve state controls interest rates and health checks for all users. updateReserveState :: Integer -> Coin -> St () updateReserveState currentTime asset = modifyReserve asset $ IR.updateReserveInterestRates currentTime {-# INLINABLE isTrustedOracle #-} +-- | check that user is allowed to do oracle actions isTrustedOracle :: UserId -> St () -isTrustedOracle uid = do - oracles <- gets lp'trustedOracles - guardError "Is not trusted oracle" $ elem uid oracles +isTrustedOracle = checkRole "Is not trusted oracle" lp'trustedOracles + +{-# INLINABLE isAdmin #-} +-- | check that user is allowed to do admin actions +isAdmin :: UserId -> St () +isAdmin = checkRole "Is not admin" lp'admins + +{-# INLINABLE checkRole #-} +checkRole :: String -> (LendingPool -> [UserId]) -> UserId -> St () +checkRole msg extract uid = do + users <- gets extract + guardError msg $ elem uid users {-# INLINABLE aToken #-} aToken :: Coin -> St Coin @@ -232,9 +246,9 @@ modifyReserve coin f = modifyReserve' coin (Right . f) -- | Modify reserve for a given asset. It can throw errors. modifyReserve' :: Coin -> (Reserve -> Either Error Reserve) -> St () modifyReserve' asset f = do - LendingPool lp users curSym coinMap healthReport oracles <- get - case M.lookup asset lp of - Just reserve -> either throwError (\x -> put $ LendingPool (M.insert asset x lp) users curSym coinMap healthReport oracles) (f reserve) + st <- get + case M.lookup asset $ lp'reserves st of + Just reserve -> either throwError (\x -> put $ st { lp'reserves = M.insert asset x $ lp'reserves st}) (f reserve) Nothing -> throwError $ "Asset is not supported" {-# INLINABLE modifyUser #-} @@ -246,10 +260,10 @@ modifyUser uid f = modifyUser' uid (Right . f) -- | Modify user info by id. It can throw errors. modifyUser' :: UserId -> (User -> Either Error User) -> St () modifyUser' uid f = do - LendingPool lp users curSym coinMap healthReport oracles <- get - case f $ fromMaybe defaultUser $ M.lookup uid users of + st <- get + case f $ fromMaybe defaultUser $ M.lookup uid $ lp'users st of Left msg -> throwError msg - Right user -> put $ LendingPool lp (M.insert uid user users) curSym coinMap healthReport oracles + Right user -> put $ st { lp'users = M.insert uid user $ lp'users st } {-# INLINABLE modifyHealthReport #-} modifyHealthReport :: (HealthReport -> HealthReport) -> St () diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 649b7bb5d..2b1cc7428 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -68,6 +68,7 @@ data LendingPool = LendingPool , lp'currency :: !CurrencySymbol -- ^ main currencySymbol of the app , lp'coinMap :: !(Map TokenName Coin) -- ^ maps aTokenNames to actual coins , lp'healthReport :: !HealthReport -- ^ map of unhealthy borrows + , lp'admins :: ![UserId] -- ^ we accept govern acts only for those users , lp'trustedOracles :: ![UserId] -- ^ we accept price changes only for those users } deriving (Show, Generic) @@ -145,14 +146,15 @@ data CoinCfg = CoinCfg deriving anyclass (FromJSON, ToJSON) {-# INLINABLE initLendingPool #-} -initLendingPool :: CurrencySymbol -> [CoinCfg] -> [UserId] -> LendingPool -initLendingPool curSym coinCfgs oracles = +initLendingPool :: CurrencySymbol -> [CoinCfg] -> [UserId] -> [UserId] -> LendingPool +initLendingPool curSym coinCfgs admins oracles = LendingPool { lp'reserves = reserves , lp'users = M.empty , lp'currency = curSym , lp'coinMap = coinMap , lp'healthReport = M.empty + , lp'admins = admins , lp'trustedOracles = oracles } where @@ -235,7 +237,10 @@ data Act , priceAct'userId :: UserId , priceAct'act :: PriceAct } -- ^ price oracle's actions - | GovernAct GovernAct -- ^ app admin's actions + | GovernAct + { governAct'userd :: UserId + , goverAct'act :: GovernAct + } -- ^ app admin's actions deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs index 5465cca15..72d938678 100644 --- a/mlabs/src/Mlabs/Nft/Contract/Nft.hs +++ b/mlabs/src/Mlabs/Nft/Contract/Nft.hs @@ -176,10 +176,6 @@ findInputStateDatum nid = do where err = throwError $ SM.SMCContractError "Can not find NFT app instance" --- | Get user id of the wallet owner. -getUserId :: HasBlockchainActions s => Contract w s NftError UserId -getUserId = fmap (UserId . pubKeyHash) ownPubKey - -- | User action endpoint userAction :: NftId -> UserAct -> NftContract () userAction nid act = do @@ -236,7 +232,7 @@ startNft StartParams{..} = do val = nftValue nftId lookups = monetaryPolicy $ nftPolicy nftId tx = mustForgeValue val - authorId <- getUserId + authorId <- ownUserId void $ SM.runInitialiseWith (client nftId) (initNft oref authorId sp'content sp'share sp'price) val lookups tx tell $ Last $ Just nftId diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 2f6215734..0fccb8590 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -63,6 +63,7 @@ depositScript = do }) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] , sp'initValue = Value.assetClassValue adaCoin 1000 + , sp'admins = [toUserId wAdmin] , sp'oracles = [toUserId wAdmin] } wait 5 diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 21a3ca09a..125be7e06 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -226,8 +226,9 @@ aCoin2 = fromToken aToken2 -- It allocates three users nad three reserves for Dollars, Euros and Liras. -- Each user has 100 units of only one currency. User 1 has dollars, user 2 has euros amd user 3 has liras. testAppConfig :: AppConfig -testAppConfig = AppConfig reserves users lendingPoolCurrency oracles +testAppConfig = AppConfig reserves users lendingPoolCurrency admins oracles where + admins = [user1] oracles = [user1] reserves = fmap (\(coin, aCoin) -> CoinCfg From 4e40f748e7d9c14499bf3f17643e925e0f13b53a Mon Sep 17 00:00:00 2001 From: anton-k Date: Mon, 7 Jun 2021 15:24:47 +0300 Subject: [PATCH 55/81] Implements demo for lendex --- mlabs/lendex-demo/Main.hs | 238 +++++++++++----- mlabs/mlabs-plutus-use-cases.cabal | 21 +- mlabs/nft-demo/Main.hs | 110 ++------ mlabs/src/Mlabs/Emulator/Types.hs | 4 + mlabs/src/Mlabs/Lending/Contract.hs | 11 + mlabs/src/Mlabs/Lending/Contract/Api.hs | 249 ++++++++++++++++ .../Mlabs/Lending/Contract/Emulator/Client.hs | 61 ++++ mlabs/src/Mlabs/Lending/Contract/Lendex.hs | 238 ---------------- mlabs/src/Mlabs/Lending/Contract/Server.hs | 139 +++++++++ .../Lending/Contract/Simulator/Handler.hs | 89 ++++++ .../Mlabs/Lending/Contract/StateMachine.hs | 135 +++++++++ mlabs/src/Mlabs/Lending/Contract/Utils.hs | 7 - mlabs/src/Mlabs/Lending/Logic/React.hs | 12 +- mlabs/src/Mlabs/Lending/Logic/Types.hs | 17 +- mlabs/src/Mlabs/Nft/Contract.hs | 11 + mlabs/src/Mlabs/Nft/Contract/Api.hs | 85 ++++++ .../src/Mlabs/Nft/Contract/Emulator/Client.hs | 42 +++ mlabs/src/Mlabs/Nft/Contract/Nft.hs | 267 ------------------ mlabs/src/Mlabs/Nft/Contract/Server.hs | 101 +++++++ .../Mlabs/Nft/Contract/Simulator/Handler.hs | 84 ++++++ mlabs/src/Mlabs/Nft/Contract/StateMachine.hs | 151 ++++++++++ mlabs/src/Mlabs/Nft/Logic/App.hs | 4 +- mlabs/src/Mlabs/Nft/Logic/React.hs | 8 +- mlabs/src/Mlabs/Nft/Logic/Types.hs | 4 +- mlabs/src/Mlabs/Plutus/Contract.hs | 74 +++++ .../src/Mlabs/Plutus/Contract/StateMachine.hs | 61 +++- mlabs/src/Mlabs/Plutus/PAB.hs | 39 +++ mlabs/test/Test/Lending/Contract.hs | 11 +- mlabs/test/Test/Lending/Init.hs | 7 +- mlabs/test/Test/Lending/Logic.hs | 5 +- mlabs/test/Test/Nft/Contract.hs | 16 +- mlabs/test/Test/Nft/Init.hs | 3 +- 32 files changed, 1591 insertions(+), 713 deletions(-) create mode 100644 mlabs/src/Mlabs/Lending/Contract.hs create mode 100644 mlabs/src/Mlabs/Lending/Contract/Api.hs create mode 100644 mlabs/src/Mlabs/Lending/Contract/Emulator/Client.hs delete mode 100644 mlabs/src/Mlabs/Lending/Contract/Lendex.hs create mode 100644 mlabs/src/Mlabs/Lending/Contract/Server.hs create mode 100644 mlabs/src/Mlabs/Lending/Contract/Simulator/Handler.hs create mode 100644 mlabs/src/Mlabs/Lending/Contract/StateMachine.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract/Api.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract/Emulator/Client.hs delete mode 100644 mlabs/src/Mlabs/Nft/Contract/Nft.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract/Server.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract/Simulator/Handler.hs create mode 100644 mlabs/src/Mlabs/Nft/Contract/StateMachine.hs create mode 100644 mlabs/src/Mlabs/Plutus/Contract.hs create mode 100644 mlabs/src/Mlabs/Plutus/PAB.hs diff --git a/mlabs/lendex-demo/Main.hs b/mlabs/lendex-demo/Main.hs index b3ef9b8a6..6f96d055c 100644 --- a/mlabs/lendex-demo/Main.hs +++ b/mlabs/lendex-demo/Main.hs @@ -2,87 +2,199 @@ module Main where import Prelude -import GHC.Generics + +import Control.Monad (when) import Control.Monad.IO.Class import Data.Functor -import Control.Monad.Freer.Extras.Log (LogMsg) -import PlutusTx.Prelude (ByteString) -import Control.Monad.Freer (Eff, Member, interpret, type (~>)) -import Control.Monad.Freer.Error (Error) -import Data.Aeson (Result(..), fromJSON) -import Data.Row (type (.\\)) -import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) - -import Plutus.PAB.Effects.Contract (ContractEffect (..)) -import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..)) -import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin -import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (..)) -import Plutus.PAB.Simulator (Simulation, SimulatorEffectHandlers) -import Plutus.PAB.Simulator qualified as Simulator -import Plutus.PAB.Types (PABError (..)) - -import Mlabs.Lending.Logic.Types -import qualified Mlabs.Lending.Contract.Lendex as Lending -import qualified Mlabs.Data.Ray as R +import Data.Monoid (Last(..)) -import Data.Text (Text) +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) +import Plutus.V1.Ledger.Contexts (pubKeyHash) import Playground.Contract +import Plutus.V1.Ledger.Value (CurrencySymbol) +import qualified Plutus.V1.Ledger.Value as Value +import Plutus.PAB.Simulator qualified as Simulator +import Wallet.Emulator.Wallet qualified as Wallet -import Plutus.Contract -import Data.Monoid (Last(..)) -import qualified Data.Text as T +import Ledger.Constraints +import Plutus.V1.Ledger.Tx +import Plutus.Contract hiding (when) -import qualified Plutus.PAB.Webserver.Server as PAB.Server +import Mlabs.Plutus.PAB +import qualified Mlabs.Data.Ray as R import Mlabs.System.Console.PrettyLogger -import Mlabs.System.Console.Utils - -import Wallet.Emulator.Wallet qualified as Wallet --- | Shortcut for Simulator monad for NFT case -type Sim a = Simulation (Builtin LendexContracts) a +import Mlabs.Lending.Logic.Types hiding (Wallet(..), User(..)) +import Mlabs.Lending.Contract --- | Lendex schemas -data LendexContracts - = Init -- ^ init wallets - | StartLendex -- ^ admin of the platform can start Lendex and provide LendexId - | User LendexId -- ^ we read Lendex identifier and instanciate schema for the user actions - | PriceOracle LendexId -- ^ price oracle actions - deriving stock (Show, Generic) - deriving anyclass (FromJSON, ToJSON) +import qualified Plutus.Contracts.Currency as Currency -instance Pretty LendexContracts where - pretty = viaShow +import Mlabs.Lending.Contract.Simulator.Handler +import Mlabs.System.Console.Utils -- | Console demo for Lendex with simulator main :: IO () -main = withSimulator handlers $ do - liftIO $ print "Hi Lendex!" +main = runSimulator lendexId initContract $ do + cur <- activateInit wAdmin + Simulator.waitNSlots 10 + admin <- activateAdmin wAdmin + oracle <- activateOracle wAdmin + users <- mapM activateUser wallets + + let [user1, user2, user3] = users + [coin1, coin2, coin3] = fmap (toCoin cur) [token1, token2, token3] + + call admin $ startParams cur + next + + logMlabs + test "Init users" (pure ()) + + test (unlines [ "Users deposit funds (100 coins in each currrency)." + , "They receive equal amount of aTokens."] + ) $ do + call user1 $ Deposit 100 coin1 + call user2 $ Deposit 100 coin2 + call user3 $ Deposit 100 coin3 + + test "User 1 borrows 60 Euros" $ do + call user1 $ SetUserReserveAsCollateral + { setCollateral'asset = coin1 + , setCollateral'useAsCollateral = True + , setCollateral'portion = 1 R.% 1 + } + call user1 $ Borrow 60 coin2 (toInterestRateFlag StableRate) + + test "User 3 withdraws 25 Liras" $ do + call user3 $ Withdraw 25 coin3 + + test (unlines [ "Rate of Euros becomes high and User1's collateral is not enough." + , "User2 liquidates part of the borrow"] + ) $ do + call oracle $ SetAssetPrice coin2 (R.fromInteger 2) + call user2 $ LiquidationCall + { liquidationCall'collateral = coin1 + , liquidationCall'debtUser = (toPubKeyHash w1) + , liquidationCall'debtAsset = coin2 + , liquidationCall'debtToCover = 10 + , liquidationCall'receiveAToken = True + } + + test "User 1 repays 20 coins of the loan" $ do + call user1 $ Repay 20 coin1 (toInterestRateFlag StableRate) + + liftIO $ putStrLn "Fin (Press enter to Exit)" where - withSimulator hs act = void $ Simulator.runSimulationWith hs $ do - Simulator.logString @(Builtin LendexContracts) "Starting Lendex PAB webserver. Press enter to exit." - shutdown <- PAB.Server.startServerDebug + next = do + logNewLine + void $ Simulator.waitNSlots 10 + + test msg act = do void $ act - void $ liftIO getLine - shutdown - -handleLendexContracts :: - ( Member (Error PABError) effs - , Member (LogMsg (PABMultiAgentMsg (Builtin LendexContracts))) effs - ) => - ContractEffect (Builtin LendexContracts) - ~> Eff effs -handleLendexContracts = Builtin.handleBuiltin getSchema getContract + void $ Simulator.waitNSlots 1 + logAction msg + mapM_ printBalance wals + next + where + wals = [1,2,3] + +initContract :: InitContract +initContract = do + ownPK <- pubKeyHash <$> ownPubKey + logInfo @String "Start forge" + cur <- + mapError (toLendexError . show @Currency.CurrencyError) + (Currency.forgeContract ownPK (fmap (, amount) [token1, token2, token3])) + let cs = Currency.currencySymbol cur + tell $ Last (Just cs) + logInfo @String "Forged coins" + giveTo ownPK w1 (toVal cs token1) + giveTo ownPK w2 (toVal cs token2) + giveTo ownPK w3 (toVal cs token3) + logInfo @String "Gave money to users" + where + amount :: Integer + amount = 1000 + + toVal cs tn = Value.singleton cs tn amount + + giveTo ownPK w v = do + let pkh = pubKeyHash $ Wallet.walletPubKey w + when (pkh /= ownPK) $ do + tx <- submitTx $ mustPayToPubKey pkh v + awaitTxConfirmed $ txId tx + +----------------------------------------------------------------------- +-- activate handlers + +activateInit :: Wallet -> Sim CurrencySymbol +activateInit wal = do + wid <- Simulator.activateContract wal Init + cur <- waitForLast wid + void $ Simulator.waitUntilFinished wid + pure cur + +activateAdmin :: Wallet -> Sim ContractInstanceId +activateAdmin wal = Simulator.activateContract wal Admin + +activateUser :: Wallet -> Sim ContractInstanceId +activateUser wal = Simulator.activateContract wal User + +activateOracle :: Wallet -> Sim ContractInstanceId +activateOracle wal = Simulator.activateContract wal Oracle + +----------------------------------------------------------------------- +-- constants + +lendexId :: LendexId +lendexId = LendexId "lendex" + +-- | Wallets that are used for testing. +wAdmin, w1, w2, w3 :: Wallet +wAdmin = Wallet 4 +w1 = Wallet 1 +w2 = Wallet 2 +w3 = Wallet 3 + +wallets :: [Wallet] +wallets = [w1, w2, w3] + +token1, token2, token3 :: TokenName +token1 = "Dollar" +token2 = "Euro" +token3 = "Lira" + +-- | Corresponding aTokens. We create aTokens in exchange for to the real coins +-- on our lending app +aToken1, aToken2, aToken3, aAda :: TokenName +aToken1 = Value.tokenName "aDollar" +aToken2 = Value.tokenName "aEuro" +aToken3 = Value.tokenName "aLira" +aAda = Value.tokenName "aAda" + +startParams :: CurrencySymbol -> StartParams +startParams cur = StartParams + { sp'coins = fmap (\(coin, aCoin) -> CoinCfg + { coinCfg'coin = coin + , coinCfg'rate = R.fromInteger 1 + , coinCfg'aToken = aCoin + , coinCfg'interestModel = defaultInterestModel + , coinCfg'liquidationBonus = 5 R.% 100 + }) + [(adaCoin, aAda), (toCoin cur token1, aToken1), (toCoin cur token2, aToken2), (toCoin cur token3, aToken3)] + , sp'initValue = Value.assetClassValue adaCoin 1000 + , sp'admins = [toPubKeyHash wAdmin] + , sp'oracles = [toPubKeyHash wAdmin] + } where - getSchema = undefined - getContract = undefined - -handlers :: SimulatorEffectHandlers (Builtin LendexContracts) -handlers = - Simulator.mkSimulatorHandlers @(Builtin LendexContracts) [] - $ interpret handleLendexContracts - +toCoin :: CurrencySymbol -> TokenName -> Coin +toCoin cur tn = Value.AssetClass (cur, tn) +-------------------------------------------------------------------- +-- utils +toPubKeyHash :: Wallet -> PubKeyHash +toPubKeyHash = pubKeyHash . Wallet.walletPubKey diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index ad139efe5..7be8e6ef3 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -39,6 +39,7 @@ library , plutus-use-cases , prettyprinter , pretty-show + , row-types , stm , lens , tasty @@ -61,9 +62,13 @@ library Mlabs.Emulator.Scene Mlabs.Emulator.Script Mlabs.Emulator.Types + Mlabs.Lending.Contract + Mlabs.Lending.Contract.Api Mlabs.Lending.Contract.Forge - Mlabs.Lending.Contract.Lendex - Mlabs.Lending.Contract.Utils + Mlabs.Lending.Contract.Emulator.Client + Mlabs.Lending.Contract.Simulator.Handler + Mlabs.Lending.Contract.Server + Mlabs.Lending.Contract.StateMachine Mlabs.Lending.Logic.App Mlabs.Lending.Logic.InterestRate Mlabs.Lending.Logic.React @@ -73,9 +78,16 @@ library Mlabs.Nft.Logic.React Mlabs.Nft.Logic.State Mlabs.Nft.Logic.Types - Mlabs.Nft.Contract.Nft + Mlabs.Nft.Contract + Mlabs.Nft.Contract.Emulator.Client + Mlabs.Nft.Contract.Simulator.Handler + Mlabs.Nft.Contract.Api Mlabs.Nft.Contract.Forge + Mlabs.Nft.Contract.Server + Mlabs.Nft.Contract.StateMachine + Mlabs.Plutus.Contract Mlabs.Plutus.Contract.StateMachine + Mlabs.Plutus.PAB Mlabs.System.Console.PrettyLogger Mlabs.System.Console.Utils default-extensions: BangPatterns @@ -107,6 +119,8 @@ library TypeSynonymInstances TupleSections NumericUnderscores + ImportQualifiedPost + RankNTypes executable mlabs-plutus-use-cases main-is: app/Main.hs @@ -174,6 +188,7 @@ executable lendex-demo , plutus-tx , plutus-tx-plugin , plutus-pab + , plutus-use-cases , prettyprinter , lens , mtl diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index a0b250167..4602db9a1 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -2,55 +2,32 @@ module Main where import Prelude -import GHC.Generics - import Control.Monad.IO.Class import Data.Functor -import Control.Monad.Freer.Extras.Log (LogMsg) import PlutusTx.Prelude (ByteString) -import Control.Monad.Freer (Eff, Member, interpret, type (~>)) -import Control.Monad.Freer.Error (Error) -import Data.Aeson (Result(..), fromJSON) -import Data.Row (type (.\\)) -import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) - -import Plutus.PAB.Effects.Contract (ContractEffect (..)) -import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..)) -import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin -import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (..)) -import Plutus.PAB.Simulator (Simulation, SimulatorEffectHandlers) + import Plutus.PAB.Simulator qualified as Simulator -import Plutus.PAB.Types (PABError (..)) +import Playground.Contract +import Plutus.Contract import Mlabs.Nft.Logic.Types -import qualified Mlabs.Nft.Contract.Nft as Nft +import Mlabs.Nft.Contract.Simulator.Handler +import qualified Mlabs.Nft.Contract as Nft import qualified Mlabs.Data.Ray as R -import Data.Text (Text) -import Playground.Contract - -import Plutus.Contract -import Data.Monoid (Last(..)) -import qualified Data.Text as T - -import qualified Plutus.PAB.Webserver.Server as PAB.Server +import Mlabs.Plutus.PAB import Mlabs.System.Console.PrettyLogger import Mlabs.System.Console.Utils -import Wallet.Emulator.Wallet qualified as Wallet - --- | Shortcut for Simulator monad for NFT case -type Sim a = Simulation (Builtin NftContracts) a - -- | Main function to run simulator main :: IO () -main = withSimulator handlers $ do +main = runSimulator startParams $ do let users = [1, 2, 3] logMlabs test "Init users" users (pure ()) - nid <- callStartNft user1 - cids <- mapM (callUser nid) [user1, user2, user3] + nid <- activateStartNft user1 + cids <- mapM (activateUser nid) [user1, user2, user3] let [u1, u2, u3] = cids test "User 2 buys" [1, 2] $ do @@ -60,16 +37,9 @@ main = withSimulator handlers $ do test "User 3 buys" [1, 2, 3] $ do setPrice u2 (Just 500) buy u3 500 (Just 1000) - where - withSimulator hs act = void $ Simulator.runSimulationWith hs $ do - Simulator.logString @(Builtin NftContracts) "Starting NFT PAB webserver. Press enter to exit." - shutdown <- PAB.Server.startServerDebug - void $ act - void $ liftIO getLine - shutdown - - printBalance n = logBalance ("WALLET " <> show n) =<< Simulator.valueAt (Wallet.walletAddress (Wallet n)) + liftIO $ putStrLn "Fin (Press enter to Exit)" + where test msg wals act = do void $ act logAction msg @@ -84,74 +54,28 @@ main = withSimulator handlers $ do -- handlers -- | Instanciates start NFT endpoint in the simulator to the given wallet -callStartNft :: Wallet -> Sim NftId -callStartNft wal = do +activateStartNft :: Wallet -> Sim NftId +activateStartNft wal = do wid <- Simulator.activateContract wal StartNft nftId <- waitForLast wid void $ Simulator.waitUntilFinished wid pure nftId -- | Instanciates user actions endpoint in the simulator to the given wallet -callUser :: NftId -> Wallet -> Sim ContractInstanceId -callUser nid wal = do +activateUser :: NftId -> Wallet -> Sim ContractInstanceId +activateUser nid wal = do Simulator.activateContract wal $ User nid --- | Waits for the given value to be written to the state of the service. --- We use it to share data between endpoints. One endpoint can write parameter to state with tell --- and in another endpoint we wait for the state-change. -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 - --- | NFT schemas -data NftContracts - = StartNft -- ^ author can start NFT and provide NftId - | User NftId -- ^ we read NftId and instanciate schema for the user actions - deriving stock (Show, Generic) - deriving anyclass (FromJSON, ToJSON) - -instance Pretty NftContracts where - pretty = viaShow - -handleNftContracts :: - ( Member (Error PABError) effs - , Member (LogMsg (PABMultiAgentMsg (Builtin NftContracts))) effs - ) => - ContractEffect (Builtin NftContracts) - ~> Eff effs -handleNftContracts = Builtin.handleBuiltin getSchema getContract - where - getSchema = \case - StartNft -> Builtin.endpointsToSchemas @(Nft.AuthorSchema .\\ BlockchainActions) - User _ -> Builtin.endpointsToSchemas @(Nft.UserSchema .\\ BlockchainActions) - getContract = \case - StartNft -> SomeBuiltin startNftContract - User nid -> SomeBuiltin (Nft.userEndpoints nid) - -handlers :: SimulatorEffectHandlers (Builtin NftContracts) -handlers = - Simulator.mkSimulatorHandlers @(Builtin NftContracts) [] - $ interpret handleNftContracts - -startNftContract :: Contract (Last NftId) Nft.AuthorSchema Text () -startNftContract = mapError (T.pack . show) $ Nft.startNft startParams - ------------------------------------------------------------- -- Script helpers -- | Call buy NFT endpoint buy :: ContractInstanceId -> Integer -> Maybe Integer -> Sim () -buy cid price newPrice = do - void $ Simulator.callEndpointOnInstance cid "buy-act" (Nft.BuyAct price newPrice) - void $ Simulator.waitNSlots 1 +buy cid price newPrice = call cid (Nft.Buy price newPrice) -- | Call set price for NFT endpoint setPrice :: ContractInstanceId -> Maybe Integer -> Sim () -setPrice cid newPrice = do - void $ Simulator.callEndpointOnInstance cid "set-price-act" (Nft.SetPriceAct newPrice) - void $ Simulator.waitNSlots 1 +setPrice cid newPrice = call cid (Nft.SetPrice newPrice) ------------------------------------------------------------- -- constants diff --git a/mlabs/src/Mlabs/Emulator/Types.hs b/mlabs/src/Mlabs/Emulator/Types.hs index e714ed2b9..8c36f123a 100644 --- a/mlabs/src/Mlabs/Emulator/Types.hs +++ b/mlabs/src/Mlabs/Emulator/Types.hs @@ -5,6 +5,7 @@ {-# OPTIONS_GHC -fobject-code #-} {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module Mlabs.Emulator.Types( UserId(..) , Coin @@ -24,6 +25,7 @@ import qualified PlutusTx as PlutusTx import Plutus.Contract (HasBlockchainActions, AsContractError, Contract, ownPubKey) import Plutus.V1.Ledger.Contexts (pubKeyHash) +import Playground.Contract (ToSchema) -- | Address of the wallet that can hold values of assets data UserId @@ -46,6 +48,8 @@ adaCoin = AssetClass (Ada.adaSymbol, Ada.adaToken) -- | Custom currency type Coin = AssetClass +deriving newtype instance ToSchema AssetClass + PlutusTx.unstableMakeIsData ''UserId -- | Get user id of the wallet owner. diff --git a/mlabs/src/Mlabs/Lending/Contract.hs b/mlabs/src/Mlabs/Lending/Contract.hs new file mode 100644 index 000000000..4d0c8f6af --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract.hs @@ -0,0 +1,11 @@ +-- | Re-export module +module Mlabs.Lending.Contract( + module X +) where + +import Mlabs.Lending.Contract.Api as X +import Mlabs.Lending.Contract.Forge as X +import Mlabs.Lending.Contract.Server as X +import Mlabs.Lending.Contract.StateMachine as X + + diff --git a/mlabs/src/Mlabs/Lending/Contract/Api.hs b/mlabs/src/Mlabs/Lending/Contract/Api.hs new file mode 100644 index 000000000..21d9b3d15 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract/Api.hs @@ -0,0 +1,249 @@ +-- | Contract API for Lendex application +module Mlabs.Lending.Contract.Api( + -- * Actions + -- ** User actions + Deposit(..) + , Borrow(..) + , Repay(..) + , SwapBorrowRateModel(..) + , SetUserReserveAsCollateral(..) + , Withdraw(..) + , LiquidationCall(..) + , InterestRateFlag(..) + , toInterestRateFlag + , fromInterestRateFlag + -- ** Admin actions + , AddReserve(..) + , StartParams(..) + -- ** Price oracle actions + , SetAssetPrice(..) + -- ** Action conversions + , IsUserAct(..) + , IsPriceAct(..) + , IsGovernAct(..) + -- * Schemas + , UserSchema + , OracleSchema + , AdminSchema +) where + + +import qualified Prelude as Hask +import PlutusTx.Prelude + +import GHC.Generics + +import Plutus.Contract +import Playground.Contract +import Plutus.V1.Ledger.Crypto +import Plutus.V1.Ledger.Value + +import Mlabs.Plutus.Contract +import Mlabs.Emulator.Types +import Mlabs.Data.Ray (Ray) +import Mlabs.Lending.Logic.Types + +----------------------------------------------------------------------- +-- lending pool actions + +-- user actions + +-- | Deposit funds to app +data Deposit = Deposit + { deposit'amount :: Integer + , deposit'asset :: Coin + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | Borrow funds. We have to allocate collateral to be able to borrow +data Borrow = Borrow + { borrow'amount :: Integer + , borrow'asset :: Coin + , borrow'rate :: InterestRateFlag + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | Repay part of the borrow +data Repay = Repay + { repay'amount :: Integer + , repay'asset :: Coin + , repay'rate :: InterestRateFlag + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | Swap borrow interest rate strategy (stable to variable) +data SwapBorrowRateModel = SwapBorrowRateModel + { swapRate'asset :: Coin + , swapRate'rate :: InterestRateFlag + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | Set some portion of deposit as collateral or some portion of collateral as deposit +data SetUserReserveAsCollateral = SetUserReserveAsCollateral + { setCollateral'asset :: Coin -- ^ which asset to use as collateral or not + , setCollateral'useAsCollateral :: Bool -- ^ should we use as collateral (True) or use as deposit (False) + , setCollateral'portion :: Ray -- ^ poriton of deposit/collateral to change status (0, 1) + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | Withdraw funds from deposit +data Withdraw = Withdraw + { withdraw'amount :: Integer + , withdraw'asset :: Coin + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | Call to liquidate borrows that are unsafe due to health check +-- (see for description) +data LiquidationCall = LiquidationCall + { liquidationCall'collateral :: Coin -- ^ which collateral do we take for borrow repay + , liquidationCall'debtUser :: PubKeyHash -- ^ identifier of the unhealthy borrow user + , liquidationCall'debtAsset :: Coin -- ^ identifier of the unhealthy borrow asset + , liquidationCall'debtToCover :: Integer -- ^ how much of the debt we cover + , liquidationCall'receiveAToken :: Bool -- ^ if true, the user receives the aTokens equivalent + -- of the purchased collateral. If false, the user receives + -- the underlying asset directly. + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- deriving stock (Show, Generic, Hask.Eq) +-- deriving anyclass (FromJSON, ToJSON) + +-- admin actions + +-- | Adds new reserve +data AddReserve = AddReserve CoinCfg + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +data StartParams = StartParams + { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA + , sp'initValue :: Value -- ^ init value deposited to the lending app + , sp'admins :: [PubKeyHash] -- ^ admins + , sp'oracles :: [PubKeyHash] -- ^ trusted oracles + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- price oracle actions + +-- | Updates for the prices of the currencies on the markets +data SetAssetPrice = SetAssetPrice Coin Ray + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +---------------------------------------------------------- +-- schemas + +-- | User actions +type UserSchema = + BlockchainActions + .\/ Call Deposit + .\/ Call Borrow + .\/ Call Repay + .\/ Call SwapBorrowRateModel + .\/ Call SetUserReserveAsCollateral + .\/ Call Withdraw + .\/ Call LiquidationCall + + +-- | Oracle schema +type OracleSchema = + BlockchainActions + .\/ Call SetAssetPrice + +-- | Admin schema +type AdminSchema = + BlockchainActions + .\/ Call AddReserve + .\/ Call StartParams + +---------------------------------------------------------- +-- proxy types for ToSchema instance + +-- | Interest rate flag. +-- +-- * 0 is stable rate +-- * everything else is variable rate +newtype InterestRateFlag = InterestRateFlag Integer + deriving newtype (Show, Hask.Eq, FromJSON, ToJSON, ToSchema) + +fromInterestRateFlag :: InterestRateFlag -> InterestRate +fromInterestRateFlag (InterestRateFlag n) + | n == 0 = StableRate + | otherwise = VariableRate + +toInterestRateFlag :: InterestRate -> InterestRateFlag +toInterestRateFlag = InterestRateFlag . \case + StableRate -> 0 + VariableRate -> 1 + +---------------------------------------------------------- +-- boilerplate to logic-act coversions + +class IsEndpoint a => IsUserAct a where + toUserAct :: a -> UserAct + +class IsEndpoint a => IsPriceAct a where + toPriceAct :: a -> PriceAct + +class IsEndpoint a => IsGovernAct a where + toGovernAct :: a -> GovernAct + +-- user acts + +instance IsUserAct Deposit where { toUserAct Deposit{..} = DepositAct deposit'amount deposit'asset } +instance IsUserAct Borrow where { toUserAct Borrow{..} = BorrowAct borrow'amount borrow'asset (fromInterestRateFlag borrow'rate) } +instance IsUserAct Repay where { toUserAct Repay{..} = RepayAct repay'amount repay'asset (fromInterestRateFlag repay'rate) } +instance IsUserAct SwapBorrowRateModel where { toUserAct SwapBorrowRateModel{..} = SwapBorrowRateModelAct swapRate'asset (fromInterestRateFlag swapRate'rate) } +instance IsUserAct SetUserReserveAsCollateral where { toUserAct SetUserReserveAsCollateral{..} = SetUserReserveAsCollateralAct setCollateral'asset setCollateral'useAsCollateral setCollateral'portion } +instance IsUserAct Withdraw where { toUserAct Withdraw{..} = WithdrawAct withdraw'amount withdraw'asset } +instance IsUserAct LiquidationCall where { toUserAct LiquidationCall{..} = LiquidationCallAct liquidationCall'collateral (BadBorrow (UserId liquidationCall'debtUser) liquidationCall'debtAsset) liquidationCall'debtToCover liquidationCall'receiveAToken } + +-- price acts + +instance IsPriceAct SetAssetPrice where { toPriceAct (SetAssetPrice asset rate) = SetAssetPriceAct asset rate } + +-- govern acts + +instance IsGovernAct AddReserve where { toGovernAct (AddReserve cfg) = AddReserveAct cfg } + +-- endpoint names + +instance IsEndpoint Deposit where + type EndpointSymbol Deposit = "deposit" + +instance IsEndpoint Borrow where + type EndpointSymbol Borrow = "borrow" + +instance IsEndpoint Repay where + type EndpointSymbol Repay = "repay" + +instance IsEndpoint SwapBorrowRateModel where + type EndpointSymbol SwapBorrowRateModel = "swap-borrow-rate-model" + +instance IsEndpoint SetUserReserveAsCollateral where + type EndpointSymbol SetUserReserveAsCollateral = "set-user-reserve-as-collateral" + +instance IsEndpoint Withdraw where + type EndpointSymbol Withdraw = "withdraw" + +instance IsEndpoint LiquidationCall where + type EndpointSymbol LiquidationCall = "liquidation-call" + +instance IsEndpoint SetAssetPrice where + type EndpointSymbol SetAssetPrice = "set-asset-price" + +instance IsEndpoint AddReserve where + type EndpointSymbol AddReserve = "add-reserve" + +instance IsEndpoint StartParams where + type EndpointSymbol StartParams = "start-lendex" + diff --git a/mlabs/src/Mlabs/Lending/Contract/Emulator/Client.hs b/mlabs/src/Mlabs/Lending/Contract/Emulator/Client.hs new file mode 100644 index 000000000..be5bca369 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract/Emulator/Client.hs @@ -0,0 +1,61 @@ +-- | Client functions to test contracts in EmulatorTrace monad. +module Mlabs.Lending.Contract.Emulator.Client( + callUserAct + , callPriceAct + , callGovernAct + , callStartLendex +) where + +import Prelude + +import Data.Functor (void) + +import Mlabs.Plutus.Contract +import Mlabs.Emulator.Types +import Mlabs.Lending.Logic.Types +import Mlabs.Lending.Contract.Api +import Mlabs.Lending.Contract.Server + +import Plutus.Trace.Emulator (EmulatorTrace, throwError, callEndpoint, activateContractWallet, EmulatorRuntimeError(..)) +import qualified Wallet.Emulator as Emulator + +--------------------------------------------------------- +-- call endpoints (for debug and testing) + +-- | Calls user act +callUserAct :: LendexId -> Emulator.Wallet -> UserAct -> EmulatorTrace () +callUserAct lid wal act = do + hdl <- activateContractWallet wal (userEndpoints lid) + void $ case act of + DepositAct{..} -> callEndpoint' hdl $ Deposit act'amount act'asset + BorrowAct{..} -> callEndpoint' hdl $ Borrow act'amount act'asset (toInterestRateFlag act'rate) + RepayAct{..} -> callEndpoint' hdl $ Repay act'amount act'asset (toInterestRateFlag act'rate) + SwapBorrowRateModelAct{..} -> callEndpoint' hdl $ SwapBorrowRateModel act'asset (toInterestRateFlag act'rate) + SetUserReserveAsCollateralAct{..} -> callEndpoint' hdl $ SetUserReserveAsCollateral act'asset act'useAsCollateral act'portion + WithdrawAct{..} -> callEndpoint' hdl $ Withdraw act'amount act'asset + FlashLoanAct -> pure () + LiquidationCallAct{..} -> + case act'debt of + BadBorrow (UserId pkh) asset -> callEndpoint' hdl $ LiquidationCall act'collateral pkh asset act'debtToCover act'receiveAToken + _ -> throwError $ GenericError "Bad borrow has wrong settings" + +-- | Calls price oracle act +callPriceAct :: LendexId -> Emulator.Wallet -> PriceAct -> EmulatorTrace () +callPriceAct lid wal act = do + hdl <- activateContractWallet wal (oracleEndpoints lid) + void $ case act of + SetAssetPriceAct coin rate -> callEndpoint @"set-asset-price" hdl $ SetAssetPrice coin rate + +-- | Calls govern act +callGovernAct :: LendexId -> Emulator.Wallet -> GovernAct -> EmulatorTrace () +callGovernAct lid wal act = do + hdl <- activateContractWallet wal (adminEndpoints lid) + void $ case act of + AddReserveAct cfg -> callEndpoint @"add-reserve" hdl $ AddReserve cfg + +-- | Calls initialisation of state for Lending pool +callStartLendex :: LendexId -> Emulator.Wallet -> StartParams -> EmulatorTrace () +callStartLendex lid wal sp = do + hdl <- activateContractWallet wal (adminEndpoints lid) + void $ callEndpoint @"start-lendex" hdl sp + diff --git a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs b/mlabs/src/Mlabs/Lending/Contract/Lendex.hs deleted file mode 100644 index b2c286d61..000000000 --- a/mlabs/src/Mlabs/Lending/Contract/Lendex.hs +++ /dev/null @@ -1,238 +0,0 @@ -{-# OPTIONS_GHC -fno-specialize #-} -{-# OPTIONS_GHC -fno-strictness #-} -module Mlabs.Lending.Contract.Lendex( - lendexAddress - , mkValidator - , scriptInstance - -- * Endpoints - , UserLendexSchema, UserApp - , userEndpoints - , PriceOracleLendexSchema, PriceOracleApp - , priceOracleEndpoints - , GovernLendexSchema, GovernApp - , governEndpoints - , StartParams(..) - -- * Test endpoints - , callUserAct - , callPriceOracleAct - , callGovernAct - , callStartLendex - , userAction - , startLendex -) where - -import qualified Prelude as P - -import Control.Monad (forever) -import Control.Monad.State.Strict (runStateT) -import Data.List.Extra (firstJust) - -import Data.Aeson (FromJSON, ToJSON) -import Data.Functor (void) - -import GHC.Generics - -import Plutus.Contract -import qualified Plutus.Contract.StateMachine as SM -import Ledger hiding (singleton) -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Constraints -import qualified PlutusTx as PlutusTx -import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) -import qualified PlutusTx.Prelude as Plutus - -import Mlabs.Emulator.Blockchain -import Mlabs.Emulator.Types -import Mlabs.Lending.Logic.React -import Mlabs.Lending.Logic.Types -import qualified Mlabs.Lending.Contract.Forge as Forge -import Mlabs.Lending.Contract.Utils - -import Plutus.Trace.Emulator (EmulatorTrace, callEndpoint, activateContractWallet) -import qualified Wallet.Emulator as Emulator - -import qualified Data.Map as M --- import Data.Text.Prettyprint.Doc.Extras - -type Lendex = SM.StateMachine (LendexId, LendingPool) Act - -{-# INLINABLE machine #-} -machine :: LendexId -> Lendex -machine lid = (SM.mkStateMachine Nothing (transition lid) isFinal) - { SM.smCheck = checkTimestamp } - where - isFinal = const False - - checkTimestamp _ input ctx = maybe True check $ getInputTime input - where - check t = member (Slot t) range - range = txInfoValidRange $ scriptContextTxInfo ctx - - getInputTime = \case - UserAct time _ _ -> Just time - PriceAct time _ _ -> Just time - _ -> Nothing - -{-# INLINABLE mkValidator #-} -mkValidator :: LendexId -> Scripts.ValidatorType Lendex -mkValidator lid = SM.mkValidator (machine lid) - -client :: LendexId -> SM.StateMachineClient (LendexId, LendingPool) Act -client lid = SM.mkStateMachineClient $ SM.StateMachineInstance (machine lid) (scriptInstance lid) - -lendexValidatorHash :: LendexId -> ValidatorHash -lendexValidatorHash lid = Scripts.scriptHash (scriptInstance lid) - -lendexAddress :: LendexId -> Address -lendexAddress lid = scriptHashAddress (lendexValidatorHash lid) - -scriptInstance :: LendexId -> Scripts.ScriptInstance Lendex -scriptInstance lid = Scripts.validator @Lendex - ($$(PlutusTx.compile [|| mkValidator ||]) - `PlutusTx.applyCode` (PlutusTx.liftCode lid) - ) - $$(PlutusTx.compile [|| wrap ||]) - where - wrap = Scripts.wrapValidator - -{-# INLINABLE transition #-} -transition :: - LendexId - -> SM.State (LendexId, LendingPool) - -> Act - -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State (LendexId, LendingPool)) -transition lid SM.State{stateData=oldData, stateValue=oldValue} input - | lid == inputLid = case runStateT (react input) (snd oldData) of - Left _err -> Nothing - Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints - , SM.State { stateData = (lid, newData) - , stateValue = updateRespValue resps oldValue }) - | otherwise = Nothing - where - inputLid = fst oldData - - -- we check that user indeed signed the transaction with his own key - ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId - - userId = case input of - UserAct _ (UserId uid) _ -> Just uid - _ -> Nothing - ------------------------------------------------------------------------ --- endpoints and schemas - -type LendexError = SM.SMContractError - -type UserLendexSchema = - BlockchainActions - .\/ Endpoint "user-action" UserAct - -type UserApp a = Contract () UserLendexSchema LendexError a - -findInputStateDatum :: LendexId -> UserApp Datum -findInputStateDatum lid = do - utxos <- utxoAt (lendexAddress lid) - maybe err P.pure $ firstJust (readDatum . snd) $ M.toList utxos - where - err = throwError $ SM.SMCContractError "Can not find Lending app instance" - -userAction :: LendexId -> UserAct -> UserApp () -userAction lid act = do - currentTimestamp <- getSlot <$> currentSlot - pkh <- fmap pubKeyHash ownPubKey - inputDatum <- findInputStateDatum lid - let lookups = monetaryPolicy (Forge.currencyPolicy lid) P.<> - ownPubKeyHash pkh - constraints = mustIncludeDatum inputDatum - t <- SM.mkStep (client lid) (UserAct currentTimestamp (UserId pkh) act) - logInfo @String $ "Executes action " P.<> show act - case t of - Left _err -> logError ("Action failed" :: String) - Right SM.StateMachineTransition{smtConstraints=constraints', smtLookups=lookups'} -> do - tx <- submitTxConstraintsWith (lookups P.<> lookups') (constraints P.<> constraints') - -- mapM_ (logInfo @String) (lines $ show $ pretty tx) - awaitTxConfirmed (txId tx) - --- | Endpoints for user -userEndpoints :: LendexId -> UserApp () -userEndpoints lid = forever userAction' - where - userAction' = endpoint @"user-action" >>= userAction lid - -type PriceOracleLendexSchema = - BlockchainActions - .\/ Endpoint "price-oracle-action" PriceAct - -type PriceOracleApp a = Contract () PriceOracleLendexSchema LendexError a - -priceOracleAction :: LendexId -> PriceAct -> PriceOracleApp () -priceOracleAction lid act = do - pkh <- fmap pubKeyHash ownPubKey - currentTimestamp <- getSlot <$> currentSlot - void $ SM.runStep (client lid) (PriceAct currentTimestamp (UserId pkh) act) - --- | Endpoints for price oracle -priceOracleEndpoints :: LendexId -> PriceOracleApp () -priceOracleEndpoints lid = forever priceOracleAction' - where - priceOracleAction' = endpoint @"price-oracle-action" >>= priceOracleAction lid - -type GovernLendexSchema = - BlockchainActions - .\/ Endpoint "govern-action" GovernAct - .\/ Endpoint "start-lendex" StartParams - -data StartParams = StartParams - { sp'coins :: [CoinCfg] -- ^ supported coins with ratios to ADA - , sp'initValue :: Value -- ^ init value deposited to the lending app - , sp'admins :: [UserId] -- ^ admins - , sp'oracles :: [UserId] -- ^ trusted oracles - } - deriving stock (Show, Generic) - deriving anyclass (FromJSON, ToJSON) - -type GovernApp a = Contract () GovernLendexSchema LendexError a - -governAction :: LendexId -> GovernAct -> GovernApp () -governAction lid act = do - uid <- ownUserId - void $ SM.runStep (client lid) (GovernAct uid act) - -startLendex :: LendexId -> StartParams -> GovernApp () -startLendex lid StartParams{..} = do - void $ SM.runInitialise (client lid) (lid, initLendingPool (Forge.currencySymbol lid) sp'coins sp'admins sp'oracles) sp'initValue - --- | Endpoints for admin user -governEndpoints :: LendexId -> GovernApp () -governEndpoints lid = startLendex' >> forever governAction' - where - governAction' = endpoint @"govern-action" >>= (governAction lid) - startLendex' = endpoint @"start-lendex" >>= (startLendex lid) - ---------------------------------------------------------- --- call endpoints (for debug and testing) - --- | Calls user act -callUserAct :: LendexId -> Emulator.Wallet -> UserAct -> EmulatorTrace () -callUserAct lid wal act = do - hdl <- activateContractWallet wal (userEndpoints lid) - void $ callEndpoint @"user-action" hdl act - --- | Calls price oracle act -callPriceOracleAct :: LendexId -> Emulator.Wallet -> PriceAct -> EmulatorTrace () -callPriceOracleAct lid wal act = do - hdl <- activateContractWallet wal (priceOracleEndpoints lid) - void $ callEndpoint @"price-oracle-action" hdl act - --- | Calls govern act -callGovernAct :: LendexId -> Emulator.Wallet -> GovernAct -> EmulatorTrace () -callGovernAct lid wal act = do - hdl <- activateContractWallet wal (governEndpoints lid) - void $ callEndpoint @"govern-action" hdl act - --- | Calls initialisation of state for Lending pool -callStartLendex :: LendexId -> Emulator.Wallet -> StartParams -> EmulatorTrace () -callStartLendex lid wal sp = do - hdl <- activateContractWallet wal (governEndpoints lid) - void $ callEndpoint @"start-lendex" hdl sp - diff --git a/mlabs/src/Mlabs/Lending/Contract/Server.hs b/mlabs/src/Mlabs/Lending/Contract/Server.hs new file mode 100644 index 000000000..658f3fec0 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract/Server.hs @@ -0,0 +1,139 @@ +-- | Server for lendex application +module Mlabs.Lending.Contract.Server( + -- * Contract monads + UserContract + , OracleContract + , AdminContract + -- * Endpoints + , userEndpoints + , oracleEndpoints + , adminEndpoints + -- * Errors + , LendexError +) where + +import Prelude +import Control.Monad + +import qualified Data.Map as M +import Data.List.Extra (firstJust) + +import Playground.Contract +import Plutus.V1.Ledger.Crypto +import Plutus.V1.Ledger.Api +import Plutus.Contract +import Ledger.Constraints + +import Mlabs.Emulator.Types +import Mlabs.Lending.Logic.Types + +import Mlabs.Plutus.Contract +import Mlabs.Lending.Contract.Api +import Mlabs.Lending.Contract.StateMachine +import qualified Mlabs.Lending.Contract.Forge as Forge + +-- | User contract monad +type UserContract a = Contract () UserSchema LendexError a + +-- | Oracle contract monad +type OracleContract a = Contract () OracleSchema LendexError a + +-- | Admin contract monad +type AdminContract a = Contract () AdminSchema LendexError a + +---------------------------------------------------------- +-- endpoints + +-- | Endpoints for user +userEndpoints :: LendexId -> UserContract () +userEndpoints lid = forever $ selects + [ act $ getEndpoint @Deposit + , act $ getEndpoint @Borrow + , act $ getEndpoint @Repay + , act $ getEndpoint @SwapBorrowRateModel + , act $ getEndpoint @SetUserReserveAsCollateral + , act $ getEndpoint @Withdraw + , act $ getEndpoint @LiquidationCall + ] + where + act :: IsUserAct a => UserContract a -> UserContract () + act readInput = readInput >>= userAction lid + + +-- | Endpoints for price oracle +oracleEndpoints :: LendexId -> OracleContract () +oracleEndpoints lid = forever $ selects + [ act $ getEndpoint @SetAssetPrice + ] + where + act :: IsPriceAct a => OracleContract a -> OracleContract () + act readInput = readInput >>= priceOracleAction lid + +-- | Endpoints for admin +adminEndpoints :: LendexId -> AdminContract () +adminEndpoints lid = do + getEndpoint @StartParams >>= (startLendex lid) + forever $ selects + [ act $ getEndpoint @AddReserve + ] + where + act :: IsGovernAct a => AdminContract a -> AdminContract () + act readInput = readInput >>= adminAction lid + +-- actions + +userAction :: IsUserAct a => LendexId -> a -> UserContract () +userAction lid input = do + pkh <- pubKeyHash <$> ownPubKey + act <- getUserAct input + inputDatum <- findInputStateDatum lid + let lookups = monetaryPolicy (Forge.currencyPolicy lid) <> + ownPubKeyHash pkh + constraints = mustIncludeDatum inputDatum + runStepWith lid act lookups constraints + +priceOracleAction :: IsPriceAct a => LendexId -> a -> OracleContract () +priceOracleAction lid input = runStep lid =<< getPriceAct input + +adminAction :: IsGovernAct a => LendexId -> a -> AdminContract () +adminAction lid input = runStep lid =<< getGovernAct input + +startLendex :: LendexId -> StartParams -> AdminContract () +startLendex lid StartParams{..} = + runInitialise lid (initLendingPool (Forge.currencySymbol lid) sp'coins (fmap UserId sp'admins) (fmap UserId sp'oracles)) sp'initValue + +---------------------------------------------------------- +-- to act conversion + +-- | Converts endpoint inputs to logic actions +getUserAct :: IsUserAct a => a -> UserContract Act +getUserAct act = do + uid <- ownUserId + t <- getCurrentTime + pure $ UserAct t uid $ toUserAct act + +-- | Converts endpoint inputs to logic actions +getPriceAct :: IsPriceAct a => a -> OracleContract Act +getPriceAct act = do + uid <- ownUserId + t <- getCurrentTime + pure $ PriceAct t uid $ toPriceAct act + +getGovernAct :: IsGovernAct a => a -> AdminContract Act +getGovernAct act = do + uid <- ownUserId + pure $ GovernAct uid $ toGovernAct act + +getCurrentTime :: (HasBlockchainActions s, AsContractError e) => Contract w s e Integer +getCurrentTime = getSlot <$> currentSlot + +---------------------------------------------------------- + +findInputStateDatum :: LendexId -> UserContract Datum +findInputStateDatum lid = do + utxos <- utxoAt (lendexAddress lid) + maybe err pure $ firstJust (readDatum . snd) $ M.toList utxos + where + err = throwError $ toLendexError "Can not find Lending app instance" + + diff --git a/mlabs/src/Mlabs/Lending/Contract/Simulator/Handler.hs b/mlabs/src/Mlabs/Lending/Contract/Simulator/Handler.hs new file mode 100644 index 000000000..6d48f6736 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract/Simulator/Handler.hs @@ -0,0 +1,89 @@ +-- | Handlers for PAB simulator +module Mlabs.Lending.Contract.Simulator.Handler( + Sim + , LendexContracts(..) + , InitContract + , runSimulator +) where + +import Prelude +import Data.Monoid (Last) +import Control.Monad.IO.Class +import Data.Functor (void) + +import Data.Aeson (ToJSON, FromJSON) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) +import GHC.Generics +import Control.Monad.Freer.Extras.Log (LogMsg) +import Control.Monad.Freer (Eff, Member, interpret, type (~>)) +import Control.Monad.Freer.Error (Error) + +import Plutus.Contract +import Plutus.V1.Ledger.Value (CurrencySymbol) +import Plutus.PAB.Effects.Contract (ContractEffect (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\)) +import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin +import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (..)) +import Plutus.PAB.Simulator (Simulation, SimulatorEffectHandlers) +import Plutus.PAB.Simulator qualified as Simulator +import Plutus.PAB.Types (PABError (..)) +import Plutus.PAB.Webserver.Server qualified as PAB.Server + +import Mlabs.Lending.Logic.Types (LendexId) +import qualified Mlabs.Lending.Contract.Api as L +import qualified Mlabs.Lending.Contract.Server as L + +-- | Shortcut for Simulator monad for NFT case +type Sim a = Simulation (Builtin LendexContracts) a + +-- | Lendex schemas +data LendexContracts + = Init -- ^ init wallets + | User -- ^ we read Lendex identifier and instanciate schema for the user actions + | Oracle -- ^ price oracle actions + | Admin -- ^ govern actions + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty LendexContracts where + pretty = viaShow + +type InitContract = Contract (Last CurrencySymbol) BlockchainActions L.LendexError () + +handleLendexContracts :: + ( Member (Error PABError) effs + , Member (LogMsg (PABMultiAgentMsg (Builtin LendexContracts))) effs + ) + => LendexId + -> InitContract + -> ContractEffect (Builtin LendexContracts) ~> Eff effs +handleLendexContracts lendexId initHandler = Builtin.handleBuiltin getSchema getContract + where + getSchema = \case + Init -> Builtin.endpointsToSchemas @Empty + User -> Builtin.endpointsToSchemas @(L.UserSchema .\\ BlockchainActions) + Oracle -> Builtin.endpointsToSchemas @(L.OracleSchema .\\ BlockchainActions) + Admin -> Builtin.endpointsToSchemas @(L.AdminSchema .\\ BlockchainActions) + getContract = \case + Init -> SomeBuiltin initHandler + User -> SomeBuiltin $ L.userEndpoints lendexId + Oracle -> SomeBuiltin $ L.oracleEndpoints lendexId + Admin -> SomeBuiltin $ L.adminEndpoints lendexId + +handlers :: LendexId -> InitContract -> SimulatorEffectHandlers (Builtin LendexContracts) +handlers lid initContract = + Simulator.mkSimulatorHandlers @(Builtin LendexContracts) [] + $ interpret (handleLendexContracts lid initContract) + +-- | Runs simulator for Lendex +runSimulator :: LendexId -> InitContract -> Sim () -> IO () +runSimulator lid initContract act = withSimulator (handlers lid initContract) act + +withSimulator :: Simulator.SimulatorEffectHandlers (Builtin LendexContracts) -> Simulation (Builtin LendexContracts) () -> IO () +withSimulator hs act = void $ Simulator.runSimulationWith hs $ do + Simulator.logString @(Builtin LendexContracts) "Starting PAB webserver. Press enter to exit." + shutdown <- PAB.Server.startServerDebug + void $ act + void $ liftIO getLine + shutdown + diff --git a/mlabs/src/Mlabs/Lending/Contract/StateMachine.hs b/mlabs/src/Mlabs/Lending/Contract/StateMachine.hs new file mode 100644 index 000000000..bf2cb74d8 --- /dev/null +++ b/mlabs/src/Mlabs/Lending/Contract/StateMachine.hs @@ -0,0 +1,135 @@ +-- | State machine and binding of transitions to Plutus for lending app +module Mlabs.Lending.Contract.StateMachine( + Lendex + , LendexError + , toLendexError + , lendexAddress + , runStep + , runStepWith + , runInitialise +) where + +import Control.Monad.State.Strict (runStateT) + +import Data.Functor (void) +import Data.String + +import Plutus.Contract +import qualified Plutus.Contract.StateMachine as SM +import Ledger hiding (singleton) +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Constraints +import qualified PlutusTx as PlutusTx +import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) +import qualified PlutusTx.Prelude as Plutus + +import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Types +import Mlabs.Lending.Logic.React +import Mlabs.Lending.Logic.Types +import qualified Mlabs.Plutus.Contract.StateMachine as SM + +type Lendex = SM.StateMachine (LendexId, LendingPool) Act + +-- | Error type +type LendexError = SM.SMContractError + +toLendexError :: String -> LendexError +toLendexError = SM.SMCContractError . fromString + +{-# INLINABLE machine #-} +machine :: LendexId -> Lendex +machine lid = (SM.mkStateMachine Nothing (transition lid) isFinal) + { SM.smCheck = checkTimestamp } + where + isFinal = const False + + checkTimestamp _ input ctx = maybe True check $ getInputTime input + where + check t = member (Slot t) range + range = txInfoValidRange $ scriptContextTxInfo ctx + + getInputTime = \case + UserAct time _ _ -> Just time + PriceAct time _ _ -> Just time + _ -> Nothing + +{-# INLINABLE mkValidator #-} +mkValidator :: LendexId -> Scripts.ValidatorType Lendex +mkValidator lid = SM.mkValidator (machine lid) + +client :: LendexId -> SM.StateMachineClient (LendexId, LendingPool) Act +client lid = SM.mkStateMachineClient $ SM.StateMachineInstance (machine lid) (scriptInstance lid) + +lendexValidatorHash :: LendexId -> ValidatorHash +lendexValidatorHash lid = Scripts.scriptHash (scriptInstance lid) + +lendexAddress :: LendexId -> Address +lendexAddress lid = scriptHashAddress (lendexValidatorHash lid) + +scriptInstance :: LendexId -> Scripts.ScriptInstance Lendex +scriptInstance lid = Scripts.validator @Lendex + ($$(PlutusTx.compile [|| mkValidator ||]) + `PlutusTx.applyCode` (PlutusTx.liftCode lid) + ) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator + +{-# INLINABLE transition #-} +transition :: + LendexId + -> SM.State (LendexId, LendingPool) + -> Act + -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State (LendexId, LendingPool)) +transition lid SM.State{stateData=oldData, stateValue=oldValue} input + | lid == inputLid = case runStateT (react input) (snd oldData) of + Left _err -> Nothing + Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints + , SM.State { stateData = (lid, newData) + , stateValue = updateRespValue resps oldValue }) + | otherwise = Nothing + where + inputLid = fst oldData + + -- we check that user indeed signed the transaction with his own key + ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId + + userId = case input of + UserAct _ (UserId uid) _ -> Just uid + _ -> Nothing + +---------------------------------------------------------------------- +-- specific versions of SM-functions + +runStep :: forall w e schema . + ( SM.AsSMContractError e + , HasUtxoAt schema + , HasWriteTx schema + , HasOwnPubKey schema + , HasTxConfirmation schema + ) => LendexId -> Act -> Contract w schema e () +runStep lid act = void $ SM.runStep (client lid) act + +runStepWith :: forall w e schema . + ( SM.AsSMContractError e + , HasUtxoAt schema + , HasWriteTx schema + , HasOwnPubKey schema + , HasTxConfirmation schema + ) + => LendexId + -> Act + -> ScriptLookups Lendex + -> TxConstraints (Scripts.RedeemerType Lendex) (Scripts.DatumType Lendex) + -> Contract w schema e () +runStepWith lid act lookups constraints = void $ SM.runStepWith (client lid) act lookups constraints + +runInitialise :: forall w e schema . + ( HasTxConfirmation schema + , HasWriteTx schema + , SM.AsSMContractError e + ) => LendexId -> LendingPool -> Value -> Contract w schema e () +runInitialise lid lendingPool val = void $ SM.runInitialise (client lid) (lid, lendingPool) val + + diff --git a/mlabs/src/Mlabs/Lending/Contract/Utils.hs b/mlabs/src/Mlabs/Lending/Contract/Utils.hs index 36bed0ef4..0f5218926 100644 --- a/mlabs/src/Mlabs/Lending/Contract/Utils.hs +++ b/mlabs/src/Mlabs/Lending/Contract/Utils.hs @@ -6,11 +6,4 @@ import Prelude (Maybe(..), ($)) import Ledger hiding (singleton) import PlutusTx --- | For off-chain code -readDatum :: IsData a => TxOutTx -> Maybe a -readDatum txOut = do - h <- txOutDatumHash $ txOutTxOut txOut - Datum e <- lookupDatum (txOutTxTx txOut) h - PlutusTx.fromData e - diff --git a/mlabs/src/Mlabs/Lending/Logic/React.hs b/mlabs/src/Mlabs/Lending/Logic/React.hs index 7feda0e88..226e07b56 100644 --- a/mlabs/src/Mlabs/Lending/Logic/React.hs +++ b/mlabs/src/Mlabs/Lending/Logic/React.hs @@ -250,7 +250,7 @@ react input = do priceAct currentTime uid act = do isTrustedOracle uid case act of - SetAssetPrice coin rate -> setAssetPrice currentTime coin rate + SetAssetPriceAct coin rate -> setAssetPrice currentTime coin rate --------------------------------------------------- -- update on market price change @@ -265,7 +265,7 @@ react input = do governAct uid act = do isAdmin uid case act of - AddReserve cfg -> addReserve cfg + AddReserveAct cfg -> addReserve cfg --------------------------------------------------- -- Adds new reserve (new coin/asset) @@ -338,10 +338,10 @@ checkInput = \case DepositAct amount asset -> do isPositive "deposit" amount isAsset asset - BorrowAct asset amount _rate -> do + BorrowAct amount asset _rate -> do isPositive "borrow" amount isAsset asset - RepayAct asset amount _rate -> do + RepayAct amount asset _rate -> do isPositive "repay" amount isAsset asset SwapBorrowRateModelAct asset _rate -> isAsset asset @@ -359,13 +359,13 @@ checkInput = \case checkPriceAct time act = do isNonNegative "price rate timestamp" time case act of - SetAssetPrice asset price -> do + SetAssetPriceAct asset price -> do checkCoinRateTimeProgress time asset isPositiveRay "price" price isAsset asset checkGovernAct = \case - AddReserve cfg -> checkCoinCfg cfg + AddReserveAct cfg -> checkCoinCfg cfg checkCoinCfg CoinCfg{..} = do isPositiveRay "coin price config" coinCfg'rate diff --git a/mlabs/src/Mlabs/Lending/Logic/Types.hs b/mlabs/src/Mlabs/Lending/Logic/Types.hs index 2b1cc7428..8945fddb3 100644 --- a/mlabs/src/Mlabs/Lending/Logic/Types.hs +++ b/mlabs/src/Mlabs/Lending/Logic/Types.hs @@ -49,6 +49,7 @@ import PlutusTx.Prelude hiding ((%)) import Plutus.V1.Ledger.Value (AssetClass(..), TokenName(..), CurrencySymbol(..)) import PlutusTx.AssocMap (Map) import qualified PlutusTx.AssocMap as M +import Playground.Contract (ToSchema) import GHC.Generics import Mlabs.Emulator.Types @@ -124,7 +125,7 @@ data InterestModel = InterestModel , im'base :: !Ray } deriving (Show, Generic, Hask.Eq) - deriving anyclass (FromJSON, ToJSON) + deriving anyclass (FromJSON, ToJSON, ToSchema) defaultInterestModel :: InterestModel defaultInterestModel = InterestModel @@ -143,7 +144,7 @@ data CoinCfg = CoinCfg , coinCfg'liquidationBonus :: Ray } deriving stock (Show, Generic, Hask.Eq) - deriving anyclass (FromJSON, ToJSON) + deriving anyclass (FromJSON, ToJSON, ToSchema) {-# INLINABLE initLendingPool #-} initLendingPool :: CurrencySymbol -> [CoinCfg] -> [UserId] -> [UserId] -> LendingPool @@ -252,14 +253,14 @@ data UserAct } -- ^ deposit funds | BorrowAct - { act'asset :: Coin - , act'amount :: Integer + { act'amount :: Integer + , act'asset :: Coin , act'rate :: InterestRate } -- ^ borrow funds. We have to allocate collateral to be able to borrow | RepayAct - { act'asset :: Coin - , act'amount :: Integer + { act'amount :: Integer + , act'asset :: Coin , act'rate :: InterestRate } -- ^ repay part of the borrow @@ -296,13 +297,13 @@ data UserAct -- | Acts that can be done by admin users. data GovernAct - = AddReserve CoinCfg -- ^ Adds new reserve + = AddReserveAct CoinCfg -- ^ Adds new reserve deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) -- | Updates for the prices of the currencies on the markets data PriceAct - = SetAssetPrice Coin Ray -- ^ Set asset price + = SetAssetPriceAct Coin Ray -- ^ Set asset price deriving stock (Show, Generic, Hask.Eq) deriving anyclass (FromJSON, ToJSON) diff --git a/mlabs/src/Mlabs/Nft/Contract.hs b/mlabs/src/Mlabs/Nft/Contract.hs new file mode 100644 index 000000000..aa731ebe9 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract.hs @@ -0,0 +1,11 @@ +-- | Re-export module +module Mlabs.Nft.Contract( + module X +) where + +import Mlabs.Nft.Contract.Api as X +import Mlabs.Nft.Contract.Forge as X +import Mlabs.Nft.Contract.Server as X +import Mlabs.Nft.Contract.StateMachine as X + + diff --git a/mlabs/src/Mlabs/Nft/Contract/Api.hs b/mlabs/src/Mlabs/Nft/Contract/Api.hs new file mode 100644 index 000000000..6b0c0bc35 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/Api.hs @@ -0,0 +1,85 @@ +-- | Contract API for Lendex application +module Mlabs.Nft.Contract.Api( + Buy(..) + , SetPrice(..) + , StartParams(..) + , UserSchema + , AuthorSchema + , IsUserAct(..) +) where + +import qualified Prelude as Hask +import PlutusTx.Prelude + +import GHC.Generics + +import Plutus.Contract +import Playground.Contract + +import Mlabs.Data.Ray (Ray) +import Mlabs.Plutus.Contract +import Mlabs.Nft.Logic.Types + +---------------------------------------------------------------------- +-- NFT endpoints + +-- user endpoints + +-- | User buys NFT +data Buy = Buy + { buy'price :: Integer + , buy'newPrice :: Maybe Integer + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- | User sets new price for NFT +data SetPrice = SetPrice + { setPrice'newPrice :: Maybe Integer + } + deriving stock (Show, Generic, Hask.Eq) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +-- author endpoints + +-- | Parameters to init NFT +data StartParams = StartParams + { sp'content :: ByteString -- ^ NFT content + , sp'share :: Ray -- ^ author share [0, 1] on reselling of the NFT + , sp'price :: Maybe Integer -- ^ current price of NFT, if it's nothing then nobody can buy it. + } + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON, ToSchema) + +---------------------------------------------------------------------- +-- schemas + +-- | User schema. Owner can set the price and the buyer can try to buy. +type UserSchema = + BlockchainActions + .\/ Call Buy + .\/ Call SetPrice + +-- | Schema for the author of NFT +type AuthorSchema = + BlockchainActions + .\/ Call StartParams + +---------------------------------------------------------------------- +-- classes + +class IsUserAct a where + toUserAct :: a -> UserAct + +instance IsUserAct Buy where { toUserAct Buy{..} = BuyAct buy'price buy'newPrice } +instance IsUserAct SetPrice where { toUserAct SetPrice{..} = SetPriceAct setPrice'newPrice } + +instance IsEndpoint Buy where + type EndpointSymbol Buy = "buy-nft" + +instance IsEndpoint SetPrice where + type EndpointSymbol SetPrice = "set-price-for-nft" + +instance IsEndpoint StartParams where + type EndpointSymbol StartParams = "start-nft" + diff --git a/mlabs/src/Mlabs/Nft/Contract/Emulator/Client.hs b/mlabs/src/Mlabs/Nft/Contract/Emulator/Client.hs new file mode 100644 index 000000000..ffbf21ccc --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/Emulator/Client.hs @@ -0,0 +1,42 @@ +-- | Client functions to test contracts in EmulatorTrace monad. +module Mlabs.Nft.Contract.Emulator.Client( + callUserAct + , callStartNft +) where + +import Prelude + +import Data.Functor (void) +import Data.Monoid (Last(..)) + +import Mlabs.Plutus.Contract +import Mlabs.Nft.Logic.Types +import Mlabs.Nft.Contract.Api +import Mlabs.Nft.Contract.Server + +import Plutus.Trace.Emulator (waitNSlots, throwError, EmulatorTrace, observableState, activateContractWallet, EmulatorRuntimeError(..)) +import qualified Wallet.Emulator as Emulator + +--------------------------------------------------------- +-- call endpoints (for debug and testing) + +-- | Calls user act +callUserAct :: NftId -> Emulator.Wallet -> UserAct -> EmulatorTrace () +callUserAct nid wal act = do + hdl <- activateContractWallet wal (userEndpoints nid) + void $ case act of + BuyAct{..} -> callEndpoint' hdl (Buy act'price act'newPrice) + SetPriceAct{..} -> callEndpoint' hdl (SetPrice act'newPrice) + +-- | Calls initialisation of state for Nft pool +callStartNft :: Emulator.Wallet -> StartParams -> EmulatorTrace NftId +callStartNft wal sp = do + hdl <- activateContractWallet wal authorEndpoints + void $ callEndpoint' hdl sp + void $ waitNSlots 10 + Last nid <- observableState hdl + maybe err pure nid + where + err = throwError $ GenericError "No NFT started in emulator" + + diff --git a/mlabs/src/Mlabs/Nft/Contract/Nft.hs b/mlabs/src/Mlabs/Nft/Contract/Nft.hs deleted file mode 100644 index 72d938678..000000000 --- a/mlabs/src/Mlabs/Nft/Contract/Nft.hs +++ /dev/null @@ -1,267 +0,0 @@ -{-# OPTIONS_GHC -fno-specialize #-} -{-# OPTIONS_GHC -fno-strictness #-} --- | Plutus bindings for NFT contract -module Mlabs.Nft.Contract.Nft( - machine - , nftAddress - , callUserAct - , callStartNft - , StartParams(..) - , UserSchema - , AuthorSchema - , startNft - , userEndpoints - , BuyAct(..) - , SetPriceAct(..) -) where - -import qualified Prelude as P - -import Control.Monad (forever) -import Control.Monad.State.Strict (runStateT) -import Data.List.Extra (firstJust) - -import Data.Aeson (FromJSON, ToJSON) -import Data.Monoid (Last(..)) -import Data.Functor (void) - -import GHC.Generics -import qualified PlutusTx.Prelude as Plutus - -import Plutus.Contract -import qualified Plutus.Contract.StateMachine as SM -import Ledger hiding (singleton) -import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Constraints -import qualified PlutusTx as PlutusTx -import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) -import qualified Control.Monad.Freer.Error as F -import Playground.Contract (ToSchema) - -import Mlabs.Emulator.Blockchain -import Mlabs.Emulator.Types -import Mlabs.Nft.Logic.React -import Mlabs.Nft.Logic.Types -import qualified Mlabs.Nft.Contract.Forge as Forge -import qualified Mlabs.Plutus.Contract.StateMachine as SM -import Mlabs.Lending.Contract.Utils - -import Plutus.Trace.Emulator (EmulatorTrace) -import qualified Plutus.Trace.Emulator as Trace -import qualified Wallet.Emulator as Emulator - -import qualified Data.Map as M -import Plutus.V1.Ledger.Value - -import Mlabs.Data.Ray (Ray) - --------------------------------------- - -type NftMachine = SM.StateMachine Nft Act -type NftMachineClient = SM.StateMachineClient Nft Act - -{-# INLINABLE machine #-} --- | State machine definition -machine :: NftId -> NftMachine -machine nftId = (SM.mkStateMachine Nothing (transition nftId) isFinal) - where - isFinal = const False - -{-# INLINABLE mkValidator #-} --- | State machine validator -mkValidator :: NftId -> Scripts.ValidatorType NftMachine -mkValidator nftId = SM.mkValidator (machine nftId) - --- | State machine client -client :: NftId -> NftMachineClient -client nftId = SM.mkStateMachineClient $ SM.StateMachineInstance (machine nftId) (scriptInstance nftId) - --- | NFT validator hash -nftValidatorHash :: NftId -> ValidatorHash -nftValidatorHash nftId = Scripts.scriptHash (scriptInstance nftId) - --- | NFT script address -nftAddress :: NftId -> Address -nftAddress nftId = scriptHashAddress (nftValidatorHash nftId) - --- | NFT script instance -scriptInstance :: NftId -> Scripts.ScriptInstance NftMachine -scriptInstance nftId = Scripts.validator @NftMachine - ($$(PlutusTx.compile [|| mkValidator ||]) - `PlutusTx.applyCode` (PlutusTx.liftCode nftId) - ) - $$(PlutusTx.compile [|| wrap ||]) - where - wrap = Scripts.wrapValidator - -{-# INLINABLE transition #-} --- | State transitions for NFT -transition :: - NftId - -> SM.State Nft - -> Act - -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State Nft) -transition nftId SM.State{stateData=oldData, stateValue=oldValue} input - | idIsValid = - case runStateT (react input) oldData of - Left _err -> Nothing - Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints - , SM.State { stateData = newData - , stateValue = updateRespValue resps oldValue }) - | otherwise = Nothing - where - idIsValid = nftId == nft'id oldData - - -- we check that user indeed signed the transaction with his own key - ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId - - userId = case input of - UserAct (UserId uid) _ -> Just uid - _ -> Nothing - ------------------------------------------------------------------------ --- NFT forge policy - --- | NFT monetary policy -nftPolicy :: NftId -> MonetaryPolicy -nftPolicy nid = Forge.currencyPolicy (nftAddress nid) nid - --- | NFT currency symbol -nftSymbol :: NftId -> CurrencySymbol -nftSymbol nid = Forge.currencySymbol (nftAddress nid) nid - --- | NFT coin (AssetClass) -nftCoin :: NftId -> AssetClass -nftCoin nid = AssetClass (nftSymbol nid, nftId'token nid) - --- | Single value of NFT coin. We check that there is only one NFT-coin can be minted. -nftValue :: NftId -> Value -nftValue nid = assetClassValue (nftCoin nid) 1 - ------------------------------------------------------------------------ --- endpoints and schemas - --- | NFT errors -type NftError = SM.SMContractError - --- | User schema. Owner can set the price and the buyer can try to buy. -type UserSchema = - BlockchainActions - .\/ Endpoint "buy-act" BuyAct - .\/ Endpoint "set-price-act" SetPriceAct - --- | User buys NFT -data BuyAct = BuyAct - { buy'price :: Integer - , buy'newPrice :: Maybe Integer - } - deriving stock (Show, Generic, P.Eq) - deriving anyclass (FromJSON, ToJSON, ToSchema) - --- | User sets new price for NFT -data SetPriceAct = SetPriceAct - { setPrice'newPrice :: Maybe Integer - } - deriving stock (Show, Generic, P.Eq) - deriving anyclass (FromJSON, ToJSON, ToSchema) - --- | NFT contract for the user -type NftContract a = Contract () UserSchema NftError a - --- | Finds Datum for NFT state machine script. -findInputStateDatum :: NftId -> NftContract Datum -findInputStateDatum nid = do - utxos <- utxoAt (nftAddress nid) - maybe err P.pure $ firstJust (readDatum . snd) $ M.toList utxos - where - err = throwError $ SM.SMCContractError "Can not find NFT app instance" - --- | User action endpoint -userAction :: NftId -> UserAct -> NftContract () -userAction nid act = do - pkh <- fmap pubKeyHash ownPubKey - inputDatum <- findInputStateDatum nid - let lookups = monetaryPolicy (nftPolicy nid) P.<> - ownPubKeyHash pkh - constraints = mustIncludeDatum inputDatum - t <- SM.mkStep (client nid) (UserAct (UserId pkh) act) - logInfo @String $ "Executes action " P.<> show act - case t of - Left _err -> logError ("Action failed" :: String) - Right SM.StateMachineTransition{smtConstraints=constraints', smtLookups=lookups'} -> do - tx <- submitTxConstraintsWith (lookups P.<> lookups') (constraints P.<> constraints') - -- mapM_ (logInfo @String) (lines $ show $ pretty tx) - awaitTxConfirmed (txId tx) - --- | Endpoints for user -userEndpoints :: NftId -> NftContract () -userEndpoints nid = forever userAction' - where - userAction' = buy `select` setPrice - - buy = endpoint @"buy-act" >>= (\BuyAct{..} -> userAction nid (Buy buy'price buy'newPrice)) - setPrice = endpoint @"set-price-act" >>= (\SetPriceAct{..} -> userAction nid (SetPrice setPrice'newPrice)) - - --- | Parameters to init NFT -data StartParams = StartParams - { sp'content :: ByteString -- ^ NFT content - , sp'share :: Ray -- ^ author share [0, 1] on reselling of the NFT - , sp'price :: Maybe Integer -- ^ current price of NFT, if it's nothing then nobody can buy it. - } - deriving stock (Show, Generic) - deriving anyclass (FromJSON, ToJSON, ToSchema) - --- | Contract for the author of NFT -type AuthorContract a = Contract (Last NftId) AuthorSchema NftError a - --- | Schema for the author of NFT -type AuthorSchema = - BlockchainActions - .\/ Endpoint "start-nft" StartParams - --- | Initialise NFt endpoint. --- We save NftId to the contract writer. -startNft :: StartParams -> AuthorContract () -startNft StartParams{..} = do - orefs <- M.keys <$> (utxoAt =<< pubKeyAddress <$> ownPubKey) - case orefs of - [] -> logError @String "No UTXO found" - oref : _ -> do - let nftId = toNftId oref sp'content - val = nftValue nftId - lookups = monetaryPolicy $ nftPolicy nftId - tx = mustForgeValue val - authorId <- ownUserId - void $ SM.runInitialiseWith (client nftId) (initNft oref authorId sp'content sp'share sp'price) val lookups tx - tell $ Last $ Just nftId - --- | Endpoints for admin user -authorEndpoints :: AuthorContract () -authorEndpoints = forever startNft' - where - startNft' = endpoint @"start-nft" >>= startNft - ---------------------------------------------------------- --- call endpoints (for debug and testing) - --- | Calls user act -callUserAct :: NftId -> Emulator.Wallet -> UserAct -> EmulatorTrace () -callUserAct nid wal act = do - hdl <- Trace.activateContractWallet wal (userEndpoints nid) - case act of - Buy{..} -> void $ Trace.callEndpoint @"buy-act" hdl (BuyAct act'price act'newPrice) - SetPrice{..} -> void $ Trace.callEndpoint @"set-price-act" hdl (SetPriceAct act'newPrice) - --- | Calls initialisation of state for Lending pool -callStartNft :: Emulator.Wallet -> StartParams -> EmulatorTrace NftId -callStartNft wal sp = do - hdl <- Trace.activateContractWallet wal authorEndpoints - void $ Trace.callEndpoint @"start-nft" hdl sp - void $ Trace.waitNSlots 10 - Last nid <- Trace.observableState hdl - maybe err P.pure nid - where - err = F.throwError $ Trace.GenericError "No NFT started in emulator" - - diff --git a/mlabs/src/Mlabs/Nft/Contract/Server.hs b/mlabs/src/Mlabs/Nft/Contract/Server.hs new file mode 100644 index 000000000..8c79c9450 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/Server.hs @@ -0,0 +1,101 @@ +module Mlabs.Nft.Contract.Server( + -- * Contracts + UserContract + , AuthorContract + -- * Endpoints + , userEndpoints + , authorEndpoints + , startNft +) where + +import Prelude +import Control.Monad + +import qualified Data.Map as M +import Data.List.Extra (firstJust) +import Data.Monoid (Last(..)) + +import Playground.Contract +import Plutus.V1.Ledger.Crypto +import Plutus.V1.Ledger.Api +import Plutus.Contract +import Ledger.Constraints +import Plutus.V1.Ledger.Address + +import Mlabs.Emulator.Types +import Mlabs.Nft.Logic.Types + +import Mlabs.Plutus.Contract +import Mlabs.Nft.Contract.Api +import Mlabs.Nft.Contract.StateMachine + +-- | NFT contract for the user +type UserContract a = Contract () UserSchema NftError a + +-- | Contract for the author of NFT +type AuthorContract a = Contract (Last NftId) AuthorSchema NftError a + +---------------------------------------------------------------- +-- endpoints + +-- | Endpoints for user +userEndpoints :: NftId -> UserContract () +userEndpoints nid = forever $ selects + [ act $ getEndpoint @Buy + , act $ getEndpoint @SetPrice + ] + where + act :: IsUserAct a => UserContract a -> UserContract () + act readInput = readInput >>= userAction nid + +-- | Endpoints for admin user +authorEndpoints :: AuthorContract () +authorEndpoints = forever startNft' + where + startNft' = getEndpoint @StartParams >>= startNft + +userAction :: IsUserAct a => NftId -> a -> UserContract () +userAction nid input = do + pkh <- pubKeyHash <$> ownPubKey + act <- getUserAct input + inputDatum <- findInputStateDatum nid + let lookups = monetaryPolicy (nftPolicy nid) <> + ownPubKeyHash pkh + constraints = mustIncludeDatum inputDatum + runStepWith nid act lookups constraints + +-- | Initialise NFt endpoint. +-- We save NftId to the contract writer. +startNft :: StartParams -> AuthorContract () +startNft StartParams{..} = do + orefs <- M.keys <$> (utxoAt =<< pubKeyAddress <$> ownPubKey) + case orefs of + [] -> logError @String "No UTXO found" + oref : _ -> do + let nftId = toNftId oref sp'content + val = nftValue nftId + lookups = monetaryPolicy $ nftPolicy nftId + tx = mustForgeValue val + authorId <- ownUserId + runInitialiseWith nftId (initNft oref authorId sp'content sp'share sp'price) val lookups tx + tell $ Last $ Just nftId + + +---------------------------------------------------------------- + +-- | Converts endpoint inputs to logic actions +getUserAct :: IsUserAct a => a -> UserContract Act +getUserAct act = do + uid <- ownUserId + pure $ UserAct uid $ toUserAct act + +---------------------------------------------------------------- +-- utils + +-- | Finds Datum for NFT state machine script. +findInputStateDatum :: NftId -> UserContract Datum +findInputStateDatum nid = do + utxos <- utxoAt (nftAddress nid) + maybe err pure $ firstJust (readDatum . snd) $ M.toList utxos + where + err = throwError $ toNftError "Can not find NFT app instance" diff --git a/mlabs/src/Mlabs/Nft/Contract/Simulator/Handler.hs b/mlabs/src/Mlabs/Nft/Contract/Simulator/Handler.hs new file mode 100644 index 000000000..41e9ea245 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/Simulator/Handler.hs @@ -0,0 +1,84 @@ +-- | Handlers for PAB simulator +module Mlabs.Nft.Contract.Simulator.Handler( + Sim + , NftContracts(..) + , runSimulator +) where + +import Prelude +import Data.Monoid (Last) +import Control.Monad.IO.Class +import Data.Functor (void) + +import Data.Aeson (ToJSON, FromJSON) +import Data.Text.Prettyprint.Doc (Pretty (..), viaShow) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Generics +import Control.Monad.Freer.Extras.Log (LogMsg) +import Control.Monad.Freer (Eff, Member, interpret, type (~>)) +import Control.Monad.Freer.Error (Error) + +import Plutus.Contract +import Plutus.PAB.Effects.Contract (ContractEffect (..)) +import Plutus.PAB.Effects.Contract.Builtin (Builtin, SomeBuiltin (..), type (.\\)) +import Plutus.PAB.Effects.Contract.Builtin qualified as Builtin +import Plutus.PAB.Monitoring.PABLogMsg (PABMultiAgentMsg (..)) +import Plutus.PAB.Simulator (Simulation, SimulatorEffectHandlers) +import Plutus.PAB.Simulator qualified as Simulator +import Plutus.PAB.Types (PABError (..)) +import Plutus.PAB.Webserver.Server qualified as PAB.Server + +import Mlabs.Nft.Logic.Types (NftId) +import qualified Mlabs.Nft.Contract.Api as Nft +import qualified Mlabs.Nft.Contract.Server as Nft + +-- | Shortcut for Simulator monad for NFT case +type Sim a = Simulation (Builtin NftContracts) a + +-- | NFT schemas +data NftContracts + = StartNft -- ^ author can start NFT and provide NftId + | User NftId -- ^ we read NftId and instanciate schema for the user actions + deriving stock (Show, Generic) + deriving anyclass (FromJSON, ToJSON) + +instance Pretty NftContracts where + pretty = viaShow + +handleNftContracts :: + ( Member (Error PABError) effs + , Member (LogMsg (PABMultiAgentMsg (Builtin NftContracts))) effs + ) + => Nft.StartParams + -> ContractEffect (Builtin NftContracts) ~> Eff effs +handleNftContracts sp = Builtin.handleBuiltin getSchema getContract + where + getSchema = \case + StartNft -> Builtin.endpointsToSchemas @(Nft.AuthorSchema .\\ BlockchainActions) + User _ -> Builtin.endpointsToSchemas @(Nft.UserSchema .\\ BlockchainActions) + getContract = \case + StartNft -> SomeBuiltin (startNftContract sp) + User nid -> SomeBuiltin (Nft.userEndpoints nid) + +handlers :: Nft.StartParams -> SimulatorEffectHandlers (Builtin NftContracts) +handlers sp = + Simulator.mkSimulatorHandlers @(Builtin NftContracts) [] + $ interpret (handleNftContracts sp) + +startNftContract :: Nft.StartParams -> Contract (Last NftId) Nft.AuthorSchema Text () +startNftContract startParams = mapError (T.pack . show) $ Nft.startNft startParams + +-- | Runs simulator for NFT +runSimulator :: Nft.StartParams -> Sim () -> IO () +runSimulator sp act = withSimulator (handlers sp) act + +withSimulator :: Simulator.SimulatorEffectHandlers (Builtin NftContracts) -> Simulation (Builtin NftContracts) () -> IO () +withSimulator hs act = void $ Simulator.runSimulationWith hs $ do + Simulator.logString @(Builtin NftContracts) "Starting PAB webserver. Press enter to exit." + shutdown <- PAB.Server.startServerDebug + void $ act + void $ liftIO getLine + shutdown + + diff --git a/mlabs/src/Mlabs/Nft/Contract/StateMachine.hs b/mlabs/src/Mlabs/Nft/Contract/StateMachine.hs new file mode 100644 index 000000000..a360d3615 --- /dev/null +++ b/mlabs/src/Mlabs/Nft/Contract/StateMachine.hs @@ -0,0 +1,151 @@ +module Mlabs.Nft.Contract.StateMachine( + NftMachine + , NftMachineClient + , NftError + , toNftError + , nftAddress + , nftPolicy + , nftValue + , runStepWith + , runInitialiseWith +) where + +import Control.Monad.State.Strict (runStateT) +import Data.Functor (void) +import Data.String + +import Plutus.Contract +import qualified Plutus.Contract.StateMachine as SM +import Ledger hiding (singleton) +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Constraints +import qualified PlutusTx as PlutusTx +import PlutusTx.Prelude hiding (Applicative (..), check, Semigroup(..), Monoid(..)) +import qualified PlutusTx.Prelude as Plutus +import Plutus.V1.Ledger.Value + +import Mlabs.Emulator.Blockchain +import Mlabs.Emulator.Types +import Mlabs.Nft.Logic.React +import Mlabs.Nft.Logic.Types +import qualified Mlabs.Nft.Contract.Forge as Forge +import qualified Mlabs.Plutus.Contract.StateMachine as SM + + +type NftMachine = SM.StateMachine Nft Act +type NftMachineClient = SM.StateMachineClient Nft Act + +-- | NFT errors +type NftError = SM.SMContractError + +toNftError :: String -> NftError +toNftError = SM.SMCContractError . fromString + +{-# INLINABLE machine #-} +-- | State machine definition +machine :: NftId -> NftMachine +machine nftId = (SM.mkStateMachine Nothing (transition nftId) isFinal) + where + isFinal = const False + +{-# INLINABLE mkValidator #-} +-- | State machine validator +mkValidator :: NftId -> Scripts.ValidatorType NftMachine +mkValidator nftId = SM.mkValidator (machine nftId) + +-- | State machine client +client :: NftId -> NftMachineClient +client nftId = SM.mkStateMachineClient $ SM.StateMachineInstance (machine nftId) (scriptInstance nftId) + +-- | NFT validator hash +nftValidatorHash :: NftId -> ValidatorHash +nftValidatorHash nftId = Scripts.scriptHash (scriptInstance nftId) + +-- | NFT script address +nftAddress :: NftId -> Address +nftAddress nftId = scriptHashAddress (nftValidatorHash nftId) + +-- | NFT script instance +scriptInstance :: NftId -> Scripts.ScriptInstance NftMachine +scriptInstance nftId = Scripts.validator @NftMachine + ($$(PlutusTx.compile [|| mkValidator ||]) + `PlutusTx.applyCode` (PlutusTx.liftCode nftId) + ) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator + +{-# INLINABLE transition #-} +-- | State transitions for NFT +transition :: + NftId + -> SM.State Nft + -> Act + -> Maybe (SM.TxConstraints SM.Void SM.Void, SM.State Nft) +transition nftId SM.State{stateData=oldData, stateValue=oldValue} input + | idIsValid = + case runStateT (react input) oldData of + Left _err -> Nothing + Right (resps, newData) -> Just ( foldMap toConstraints resps Plutus.<> ctxConstraints + , SM.State { stateData = newData + , stateValue = updateRespValue resps oldValue }) + | otherwise = Nothing + where + idIsValid = nftId == nft'id oldData + + -- we check that user indeed signed the transaction with his own key + ctxConstraints = maybe Plutus.mempty mustBeSignedBy userId + + userId = case input of + UserAct (UserId uid) _ -> Just uid + _ -> Nothing + +----------------------------------------------------------------------- +-- NFT forge policy + +-- | NFT monetary policy +nftPolicy :: NftId -> MonetaryPolicy +nftPolicy nid = Forge.currencyPolicy (nftAddress nid) nid + +-- | NFT currency symbol +nftSymbol :: NftId -> CurrencySymbol +nftSymbol nid = Forge.currencySymbol (nftAddress nid) nid + +-- | NFT coin (AssetClass) +nftCoin :: NftId -> AssetClass +nftCoin nid = AssetClass (nftSymbol nid, nftId'token nid) + +-- | Single value of NFT coin. We check that there is only one NFT-coin can be minted. +nftValue :: NftId -> Value +nftValue nid = assetClassValue (nftCoin nid) 1 + +------------------------------------------------------------------------ + +runStepWith :: forall w e schema . + ( SM.AsSMContractError e + , HasUtxoAt schema + , HasWriteTx schema + , HasOwnPubKey schema + , HasTxConfirmation schema + ) + => NftId + -> Act + -> ScriptLookups NftMachine + -> TxConstraints (Scripts.RedeemerType NftMachine) (Scripts.DatumType NftMachine) + -> Contract w schema e () +runStepWith nid act lookups constraints = void $ SM.runStepWith (client nid) act lookups constraints + +runInitialiseWith :: + ( SM.AsSMContractError e + , HasUtxoAt schema + , HasWriteTx schema + , HasOwnPubKey schema + , HasTxConfirmation schema + ) + => NftId + -> Nft + -> Value + -> ScriptLookups NftMachine + -> TxConstraints (Scripts.RedeemerType NftMachine) (Scripts.DatumType NftMachine) + -> Contract w schema e () +runInitialiseWith nftId nft val lookups tx = void $ SM.runInitialiseWith (client nftId) nft val lookups tx diff --git a/mlabs/src/Mlabs/Nft/Logic/App.hs b/mlabs/src/Mlabs/Nft/Logic/App.hs index 046eaf7ac..b83a0c523 100644 --- a/mlabs/src/Mlabs/Nft/Logic/App.hs +++ b/mlabs/src/Mlabs/Nft/Logic/App.hs @@ -69,9 +69,9 @@ type Script = S.Script Act -- | User buys NFTs buy :: UserId -> Integer -> Maybe Integer -> Script -buy uid price newPrice = S.putAct $ UserAct uid (Buy price newPrice) +buy uid price newPrice = S.putAct $ UserAct uid (BuyAct price newPrice) -- | Set price of NFT setPrice :: UserId -> Maybe Integer -> Script -setPrice uid newPrice = S.putAct $ UserAct uid (SetPrice newPrice) +setPrice uid newPrice = S.putAct $ UserAct uid (SetPriceAct newPrice) diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs index 2ab1d9cf5..fb18d4a35 100644 --- a/mlabs/src/Mlabs/Nft/Logic/React.hs +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -26,8 +26,8 @@ react :: Act -> St [Resp] react inp = do checkInputs inp case inp of - UserAct uid (Buy price newPrice) -> buyAct uid price newPrice - UserAct uid (SetPrice price) -> setPriceAct uid price + UserAct uid (BuyAct price newPrice) -> buyAct uid price newPrice + UserAct uid (SetPriceAct price) -> setPriceAct uid price where ----------------------------------------------- -- buy @@ -63,9 +63,9 @@ react inp = do -- | Check inputs for valid values. checkInputs :: Act -> St () checkInputs (UserAct _uid act) = case act of - Buy price newPrice -> do + BuyAct price newPrice -> do isPositive "Buy price" price Maybe.mapM_ (isPositive "New price") newPrice - SetPrice price -> Maybe.mapM_ (isPositive "Set price") price + SetPriceAct price -> Maybe.mapM_ (isPositive "Set price") price diff --git a/mlabs/src/Mlabs/Nft/Logic/Types.hs b/mlabs/src/Mlabs/Nft/Logic/Types.hs index 439337eff..22dc1448b 100644 --- a/mlabs/src/Mlabs/Nft/Logic/Types.hs +++ b/mlabs/src/Mlabs/Nft/Logic/Types.hs @@ -82,12 +82,12 @@ data Act = UserAct UserId UserAct -- | Actions with NFTs data UserAct - = Buy + = BuyAct { act'price :: Integer -- ^ price to buy , act'newPrice :: Maybe Integer -- ^ new price for NFT (Nothing locks NFT) } -- ^ Buy NFT and set new price - | SetPrice + | SetPriceAct { act'newPrice :: Maybe Integer -- ^ new price for NFT (Nothing locks NFT) } -- ^ Set new price for NFT diff --git a/mlabs/src/Mlabs/Plutus/Contract.hs b/mlabs/src/Mlabs/Plutus/Contract.hs new file mode 100644 index 000000000..c88110b5b --- /dev/null +++ b/mlabs/src/Mlabs/Plutus/Contract.hs @@ -0,0 +1,74 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | Useful utils for contracts +module Mlabs.Plutus.Contract( + selects + , readDatum + , Call + , IsEndpoint(..) + , endpointName + , getEndpoint + , callSimulator + , callEndpoint' +) where + +import Data.Aeson (ToJSON) +import Playground.Contract (ToSchema) + +import Control.Monad.Freer (Eff) +import Data.Row +import Data.OpenUnion +import Data.Proxy +import Data.Kind +import GHC.TypeLits +import Data.Functor (void) + +import Prelude +import Plutus.Contract + +import Ledger hiding (singleton) +import PlutusTx +import Plutus.PAB.Simulator (Simulation) +import Plutus.PAB.Simulator qualified as Simulator +import Plutus.PAB.Effects.Contract.Builtin (Builtin) +import Plutus.Trace.Emulator.Types +import Plutus.Trace.Effects.RunContract (callEndpoint, RunContract) + +instance Semigroup (Contract w s e a) where + (<>) = select + +-- |Concat many endponits to one +selects :: [Contract w s e a] -> Contract w s e a +selects = foldl1 select + +-- | For off-chain code +readDatum :: IsData a => TxOutTx -> Maybe a +readDatum txOut = do + h <- txOutDatumHash $ txOutTxOut txOut + Datum e <- lookupDatum (txOutTxTx txOut) h + PlutusTx.fromData e + +type Call a = Endpoint (EndpointSymbol a) a + +class (ToSchema a, ToJSON a, KnownSymbol (EndpointSymbol a)) => IsEndpoint a where + type EndpointSymbol a :: Symbol + +callEndpoint' :: + forall ep w s e effs. + (IsEndpoint ep, ContractConstraints s, HasEndpoint (EndpointSymbol ep) ep s, Member RunContract effs) + => ContractHandle w s e -> ep -> Eff effs () +callEndpoint' hdl act = callEndpoint @(EndpointSymbol ep) hdl act + +getEndpoint :: forall a w (s :: Row Type) e . (HasEndpoint (EndpointSymbol a) a s, AsContractError e, IsEndpoint a) => Contract w s e a +getEndpoint = endpoint @(EndpointSymbol a) + +endpointName :: forall a . IsEndpoint a => a -> String +endpointName a = symbolVal (toProxy a) + where + toProxy :: a -> Proxy (EndpointSymbol a) + toProxy _ = Proxy + +callSimulator :: IsEndpoint a => ContractInstanceId -> a -> Simulation (Builtin schema) () +callSimulator cid input = do + void $ Simulator.callEndpointOnInstance cid (endpointName input) input + void $ Simulator.waitNSlots 1 + diff --git a/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs b/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs index 65d4233fa..9ad3f13f4 100644 --- a/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs +++ b/mlabs/src/Mlabs/Plutus/Contract/StateMachine.hs @@ -1,20 +1,23 @@ {-# LANGUAGE NamedFieldPuns #-} -- | Missing functions for StateMachine module Mlabs.Plutus.Contract.StateMachine( - runInitialiseWith + runInitialiseWith + , runStepWith ) where import Prelude +import Data.Void (absurd) import Control.Lens import Control.Monad.Error.Lens -import Ledger.Constraints (ScriptLookups, mustPayToTheScript) +import Ledger.Constraints (ScriptLookups, mustPayToTheScript, UnbalancedTx) import qualified Ledger.Constraints.OffChain as Constraints import qualified Ledger.Typed.Scripts as Scripts import Plutus.Contract import qualified Plutus.Contract.StateMachine.OnChain as SM import qualified PlutusTx as PlutusTx import Ledger.Value +import Plutus.V1.Ledger.Contexts (pubKeyHash) import Plutus.Contract.StateMachine @@ -44,3 +47,57 @@ runInitialiseWith StateMachineClient{scInstance} initialState initialValue custo submitTxConfirmed utx pure initialState +-- | Run one step of a state machine, returning the new state. +runStepWith :: + forall w e state schema input. + ( AsSMContractError e + , PlutusTx.IsData state + , PlutusTx.IsData input + , HasUtxoAt schema + , HasWriteTx schema + , HasOwnPubKey schema + , HasTxConfirmation schema + ) + => StateMachineClient state input + -- ^ The state machine + -> input + -- ^ The input to apply to the state machine + -> ScriptLookups (StateMachine state input) + -> TxConstraints (Scripts.RedeemerType (StateMachine state input)) (Scripts.DatumType (StateMachine state input)) + -> Contract w schema e (TransitionResult state input) +runStepWith smc input lookups constraints = + runGuardedStepWith smc input lookups constraints (\_ _ _ -> Nothing) >>= pure . \case + Left a -> absurd a + Right a -> a + +-- | Tries to run one step of a state machine: If the /guard/ (the last argument) returns @'Nothing'@ when given the +-- unbalanced transaction to be submitted, the old state and the new step, the step is run and @'Right'@ the new state is returned. +-- If the guard returns @'Just' a@, @'Left' a@ is returned instead. +runGuardedStepWith :: + forall w a e state schema input. + ( AsSMContractError e + , PlutusTx.IsData state + , PlutusTx.IsData input + , HasUtxoAt schema + , HasWriteTx schema + , HasOwnPubKey schema + , HasTxConfirmation schema + ) + => StateMachineClient state input -- ^ The state machine + -> input -- ^ The input to apply to the state machine + -> ScriptLookups (StateMachine state input) + -> TxConstraints (Scripts.RedeemerType (StateMachine state input)) (Scripts.DatumType (StateMachine state input)) + -> (UnbalancedTx -> state -> state -> Maybe a) -- ^ The guard to check before running the step + -> Contract w schema e (Either a (TransitionResult state input)) +runGuardedStepWith smc input userLookups userConstraints guard = mapError (review _SMContractError) $ mkStep smc input >>= \case + Right (StateMachineTransition{smtConstraints,smtOldState=State{stateData=os}, smtNewState=State{stateData=ns}, smtLookups}) -> do + pk <- ownPubKey + let lookups = smtLookups { Constraints.slOwnPubkey = Just $ pubKeyHash pk } + utx <- either (throwing _ConstraintResolutionError) pure (Constraints.mkTx (lookups <> userLookups) (smtConstraints <> userConstraints)) + case guard utx os ns of + Nothing -> do + submitTxConfirmed utx + pure $ Right $ TransitionSuccess ns + Just a -> pure $ Left a + Left e -> pure $ Right $ TransitionFailure e + diff --git a/mlabs/src/Mlabs/Plutus/PAB.hs b/mlabs/src/Mlabs/Plutus/PAB.hs new file mode 100644 index 000000000..bb023403c --- /dev/null +++ b/mlabs/src/Mlabs/Plutus/PAB.hs @@ -0,0 +1,39 @@ +module Mlabs.Plutus.PAB( + call + , waitForLast + , printBalance +) where + +import Prelude +import Data.Aeson (FromJSON, Result(..), fromJSON) +import Data.Functor (void) +import Data.Monoid (Last(..)) + +import Plutus.Contract +import Plutus.PAB.Simulator (Simulation) +import Plutus.PAB.Simulator qualified as Simulator +import Wallet.Emulator.Wallet (Wallet(..)) +import Wallet.Emulator.Wallet qualified as Wallet + +import Mlabs.Plutus.Contract +import Mlabs.System.Console.Utils +import Plutus.PAB.Effects.Contract.Builtin (Builtin) + +call :: IsEndpoint a => ContractInstanceId -> a -> Simulation (Builtin schema) () +call cid input = do + void $ Simulator.callEndpointOnInstance cid (endpointName input) input + void $ Simulator.waitNSlots 2 + +-- | Waits for the given value to be written to the state of the service. +-- We use it to share data between endpoints. One endpoint can write parameter to state with tell +-- and in another endpoint we wait for the state-change. +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 + +printBalance :: Integer -> Simulation (Builtin schema) () +printBalance n = + logBalance ("WALLET " <> show n) =<< Simulator.valueAt (Wallet.walletAddress (Wallet n)) + diff --git a/mlabs/test/Test/Lending/Contract.hs b/mlabs/test/Test/Lending/Contract.hs index 0fccb8590..bee66106c 100644 --- a/mlabs/test/Test/Lending/Contract.hs +++ b/mlabs/test/Test/Lending/Contract.hs @@ -16,7 +16,8 @@ import Mlabs.Emulator.Scene import Mlabs.Lending.Logic.Types ( UserAct(..), InterestRate(..), CoinCfg(..), defaultInterestModel , PriceAct(..), BadBorrow(..)) -import qualified Mlabs.Lending.Contract.Lendex as L +import qualified Mlabs.Lending.Contract as L +import qualified Mlabs.Lending.Contract.Emulator.Client as L import qualified Plutus.V1.Ledger.Value as Value import Test.Utils @@ -63,8 +64,8 @@ depositScript = do }) [(adaCoin, aAda), (coin1, aToken1), (coin2, aToken2), (coin3, aToken3)] , sp'initValue = Value.assetClassValue adaCoin 1000 - , sp'admins = [toUserId wAdmin] - , sp'oracles = [toUserId wAdmin] + , sp'admins = [toPubKeyHash wAdmin] + , sp'oracles = [toPubKeyHash wAdmin] } wait 5 userAct1 $ DepositAct 50 coin1 @@ -204,7 +205,7 @@ repayScene = borrowScene <> repayChange liquidationCallScript :: Bool -> Trace.EmulatorTrace () liquidationCallScript receiveAToken = do borrowScript - priceAct wAdmin $ SetAssetPrice coin2 (R.fromInteger 2) + priceAct wAdmin $ SetAssetPriceAct coin2 (R.fromInteger 2) next userAct2 $ LiquidationCallAct { act'collateral = coin1 @@ -230,5 +231,5 @@ liquidationCallScene receiveAToken = borrowScene <> liquidationCallChange -- names as in script test priceAct :: Wallet -> PriceAct -> Trace.EmulatorTrace () -priceAct wal act = L.callPriceOracleAct lendexId wal act +priceAct wal act = L.callPriceAct lendexId wal act diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index c4ff9c43f..55db8732f 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -8,6 +8,7 @@ module Test.Lending.Init( , aCoin1, aCoin2, aCoin3 , initialDistribution , toUserId + , toPubKeyHash , lendexId ) where @@ -18,6 +19,7 @@ import Control.Lens import Plutus.V1.Ledger.Value (Value, TokenName) import qualified Plutus.V1.Ledger.Ada as Ada import qualified Plutus.V1.Ledger.Value as Value +import Plutus.V1.Ledger.Crypto (PubKeyHash(..)) import Plutus.V1.Ledger.Contexts (pubKeyHash) import qualified Data.Map as M @@ -26,7 +28,7 @@ import qualified Plutus.Trace.Emulator as Trace import Mlabs.Lending.Logic.Types (LendexId(..), Coin, UserAct(..), UserId(..)) import qualified Mlabs.Lending.Logic.App as L -import qualified Mlabs.Lending.Contract.Lendex as L +import qualified Mlabs.Lending.Contract.Emulator.Client as L import qualified Mlabs.Lending.Contract.Forge as Forge checkOptions :: CheckOptions @@ -42,6 +44,9 @@ w3 = Wallet 3 toUserId :: Wallet -> UserId toUserId = UserId . pubKeyHash . walletPubKey +toPubKeyHash :: Wallet -> PubKeyHash +toPubKeyHash = pubKeyHash . walletPubKey + -- | Identifier for our lendex platform lendexId :: LendexId lendexId = LendexId "MLabs lending platform" diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index 125be7e06..dc3187471 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -17,7 +17,6 @@ import Mlabs.Lending.Logic.Types import qualified Data.Map.Strict as M -import Mlabs.Data.Ray ((%)) import qualified Mlabs.Data.Ray as R -- | Test suite for a logic of lending application @@ -174,7 +173,7 @@ repayScript = do liquidationCallScript :: Bool -> Script liquidationCallScript receiveAToken = do borrowScript - priceAct user1 $ SetAssetPrice coin2 (R.fromInteger 2) + priceAct user1 $ SetAssetPriceAct coin2 (R.fromInteger 2) userAct user2 $ LiquidationCallAct { act'collateral = coin1 , act'debt = BadBorrow user1 coin2 @@ -186,7 +185,7 @@ liquidationCallScript receiveAToken = do wrongUserPriceSetScript :: Script wrongUserPriceSetScript = do - priceAct user2 $ SetAssetPrice coin2 (R.fromInteger 2) + priceAct user2 $ SetAssetPriceAct coin2 (R.fromInteger 2) --------------------------------- -- constants diff --git a/mlabs/test/Test/Nft/Contract.hs b/mlabs/test/Test/Nft/Contract.hs index 13c78cd65..81500a2bc 100644 --- a/mlabs/test/Test/Nft/Contract.hs +++ b/mlabs/test/Test/Nft/Contract.hs @@ -35,9 +35,9 @@ noChangesScene = foldMap ( `ownsAda` 0) [w1, w2, w3] -- | 3 users deposit 50 coins to lending app. Each of them uses different coin. buyScript :: Script buyScript = do - userAct w1 $ SetPrice (Just 100) - userAct w2 $ Buy 100 Nothing - userAct w2 $ SetPrice (Just 500) + userAct w1 $ SetPriceAct (Just 100) + userAct w2 $ BuyAct 100 Nothing + userAct w2 $ SetPriceAct (Just 500) buyScene :: Scene buyScene = mconcat @@ -53,7 +53,7 @@ buyScene = mconcat buyTwiceScript :: Script buyTwiceScript = do buyScript - userAct w3 $ Buy 500 (Just 1000) + userAct w3 $ BuyAct 500 (Just 1000) buyTwiceScene :: Scene buyTwiceScene = buyScene <> buyTwiceChange @@ -72,7 +72,7 @@ buyTwiceScene = buyScene <> buyTwiceChange failToSetPriceScript :: Script failToSetPriceScript = do buyScript - userAct w1 $ SetPrice (Just 200) + userAct w1 $ SetPriceAct (Just 200) -------------------------------------------------------------------------------- -- fail to buy locked @@ -80,7 +80,7 @@ failToSetPriceScript = do -- | User 2 tries to buy NFT which is locked (no price is set) failToBuyLockedScript :: Script failToBuyLockedScript = do - userAct w2 $ Buy 1000 Nothing + userAct w2 $ BuyAct 1000 Nothing -------------------------------------------------------------------------------- -- fail to buy with not enough money @@ -88,6 +88,6 @@ failToBuyLockedScript = do -- | User 2 tries to buy open NFT with not enough money failToBuyNotEnoughPriceScript :: Script failToBuyNotEnoughPriceScript = do - userAct w1 $ SetPrice (Just 100) - userAct w2 $ Buy 10 Nothing + userAct w1 $ SetPriceAct (Just 100) + userAct w2 $ BuyAct 10 Nothing diff --git a/mlabs/test/Test/Nft/Init.hs b/mlabs/test/Test/Nft/Init.hs index 8cd9e126a..b149bdd38 100644 --- a/mlabs/test/Test/Nft/Init.hs +++ b/mlabs/test/Test/Nft/Init.hs @@ -31,7 +31,8 @@ import qualified Plutus.Trace.Emulator as Trace import Mlabs.Emulator.Types import Mlabs.Nft.Logic.Types (UserAct(..), NftId) -import qualified Mlabs.Nft.Contract.Nft as N +import qualified Mlabs.Nft.Contract as N +import qualified Mlabs.Nft.Contract.Emulator.Client as N import Test.Utils (next) From 3ac15cd5d5f49fada834a1da177a2c80920516be Mon Sep 17 00:00:00 2001 From: Ben Hart Date: Tue, 8 Jun 2021 13:45:45 -0400 Subject: [PATCH 56/81] clarify logs --- mlabs/mlabs-plutus-use-cases.cabal | 58 +++++++++++++++--------------- mlabs/nft-demo/Main.hs | 8 +++-- 2 files changed, 34 insertions(+), 32 deletions(-) diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index a20f42015..ae770ac3e 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -141,35 +141,35 @@ executable mlabs-plutus-use-cases , freer-extras default-language: Haskell2010 -executable demo - main-is: Main.hs - hs-source-dirs: demo - default-extensions: AllowAmbiguousTypes BlockArguments BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase ExplicitNamespaces FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns ImportQualifiedPost RoleAnnotations - ghc-options: -Wall -Wcompat -Weverything -Wmissing-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-unused-packages -Wno-unsafe -Wno-prepositive-qualified-module -Wno-missing-export-lists -Wno-unused-imports -Werror -Wwarn=redundant-constraints -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fobject-code -fno-strictness -threaded -rtsopts -with-rtsopts=-N - build-depends: - aeson - , base - , bytestring - , cardano-prelude - , containers - , data-default-class - , freer-extras - , freer-simple - , lens - , mlabs-plutus-use-cases - , playground-common - , plutus-contract - , plutus-core - , plutus-ledger - , plutus-ledger-api - , plutus-pab - , plutus-tx - , plutus-tx-plugin - , prettyprinter - , row-types - , text - , vector - default-language: Haskell2010 +-- executable demo + -- main-is: Main.hs + -- hs-source-dirs: demo + -- default-extensions: AllowAmbiguousTypes BlockArguments BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveAnyClass DeriveFunctor DeriveGeneric DerivingStrategies DerivingVia DuplicateRecordFields EmptyCase ExplicitNamespaces FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedLabels OverloadedStrings PatternSynonyms RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances ViewPatterns ImportQualifiedPost RoleAnnotations + -- ghc-options: -Wall -Wcompat -Weverything -Wmissing-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-unused-packages -Wno-unsafe -Wno-prepositive-qualified-module -Wno-missing-export-lists -Wno-unused-imports -Werror -Wwarn=redundant-constraints -fno-ignore-interface-pragmas -fno-omit-interface-pragmas -fobject-code -fno-strictness -threaded -rtsopts -with-rtsopts=-N + -- build-depends: + -- aeson + -- , base + -- , bytestring + -- , cardano-prelude + -- , containers + -- , data-default-class + -- , freer-extras + -- , freer-simple + -- , lens + -- , mlabs-plutus-use-cases + -- , playground-common + -- , plutus-contract + -- , plutus-core + -- , plutus-ledger + -- , plutus-ledger-api + -- , plutus-pab + -- , plutus-tx + -- , plutus-tx-plugin + -- , prettyprinter + -- , row-types + -- , text + -- , vector + -- default-language: Haskell2010 executable nft-demo main-is: nft-demo/Main.hs diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index 4602db9a1..2d43ad863 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -26,15 +26,17 @@ main = runSimulator startParams $ do logMlabs test "Init users" users (pure ()) + test "User 1 creates the Mona lisa (NFT)" users (pure ()) + nid <- activateStartNft user1 cids <- mapM (activateUser nid) [user1, user2, user3] - let [u1, u2, u3] = cids + let [u1, u2, u3] = cids - test "User 2 buys" [1, 2] $ do + test "User 1 sets the Mona Lisa's price to 100 Lovelace, User 2 buys The Mona Lisa from User 1 for 100 Lovelace (what a deal!), User 2 has specified that the Mona Lisa is not for sale" [1, 2] $ do setPrice u1 (Just 100) buy u2 100 Nothing - test "User 3 buys" [1, 2, 3] $ do + test "User 2 sets the sale price to 500 Lovelace, User 3 buys The Mona Lisa from User 2 for 500 Lovelace setting the new sale price to 1000 Lovelace, User 1 receives a royalty from the sale" [1, 2, 3] $ do setPrice u2 (Just 500) buy u3 500 (Just 1000) From 840afc38c4e25846df2ef266f9af9e08905705f0 Mon Sep 17 00:00:00 2001 From: Oleg Prutz Date: Fri, 11 Jun 2021 19:15:50 +0300 Subject: [PATCH 57/81] Minimal Plutus Playground frontend codegen example --- notes/codegen.md | 61 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) create mode 100644 notes/codegen.md diff --git a/notes/codegen.md b/notes/codegen.md new file mode 100644 index 000000000..e19f989ba --- /dev/null +++ b/notes/codegen.md @@ -0,0 +1,61 @@ +# Playground frontend form generation + +In order to handle arbitrary datatypes and their values, Plutus uses +classes `ToSchema` and `ToArgument` and the `FormArgument` datatype. +`FormArgument` is based on the `Fix` type from `recursion-schemes` which is used +by some of the frontend code. + +Minimal example on the Haskell side (uses `LockArgs` from `GameStateMachine.hs` use case): + +``` +nix-shell shell.nix +cd plutus-use-cases/ +cabal repl +``` + +``` +import Schema +import Ledger.Value as V +import Ledger.Ada as Ada +import Plutus.Contracts.GameStateMachineargs = LockArgs "hello" (Ada.lovelaceValueOf 10000000) +toArgument args + +Fix (FormObjectF [("lockArgsSecret",Fix (FormStringF (Just "hello"))),("lockArgsValue",Fix (FormValueF (Value (Map [(,Map [("",10000000)])]))))]) +``` + +This is the code responsible for generating endpoint argument forms +in Plutus Playground on the PureScript side: + +https://github.com/input-output-hk/plutus/blob/74cb849b6580d937a97aff42636d4ddc6a140ed6/plutus-playground-client/src/Action/View.purs#L88 +https://github.com/input-output-hk/plutus/blob/74cb849b6580d937a97aff42636d4ddc6a140ed6/web-common-plutus/src/Schema/View.purs#L32-L307 + +(the commit is fixed here for convenience) + +The PureScript frontend uses Halogen to generate HTML, here is the example: + +``` +nix-shell shell.nix +cd plutus-playground-client/ +spago repl +``` + +``` +import Schema.View +import Data.BigInteger as BigInteger +import Data.Functor.Foldable (Fix(..)) +import Data.Int as Int +import Data.Json.JsonTuple (JsonTuple(..)) +import Data.Tuple +import Data.Maybe +import Halogen.HTML +import Schema +import Schema.Types +import Plutus.V1.Ledger.Value +import PlutusTx.AssocMap as AssocMap +import Data.Unit + +v = Fix (FormValueF (Value { getValue: AssocMap.fromTuples [ ( Tuple (CurrencySymbol { unCurrencySymbol: "" }) (AssocMap.fromTuples [ Tuple (TokenName { unTokenName: "" }) (BigInteger.fromInt 10000000) ])) ] })) +s = Fix (FormStringF (Just "hello")) +f = Fix (FormObjectF [JsonTuple (Tuple "lockArgsSecret" s), JsonTuple (Tuple "lockArgsValue" v)]) +html = actionArgumentForm 0 (\_ -> unit) f :: HTML Unit Unit +``` From 1e49bcb40aee9bf35c575f33b28f9a1d437f75c1 Mon Sep 17 00:00:00 2001 From: Neil Rutledge Date: Sun, 13 Jun 2021 16:54:54 -0400 Subject: [PATCH 58/81] Add currency generating contract for demos --- mlabs/mlabs-plutus-use-cases.cabal | 2 + mlabs/src/Mlabs/Demo/Contract/Mint.hs | 218 ++++++++++++++++++++++++++ mlabs/test/Test/Demo/Contract/Mint.hs | 88 +++++++++++ 3 files changed, 308 insertions(+) create mode 100644 mlabs/src/Mlabs/Demo/Contract/Mint.hs create mode 100644 mlabs/test/Test/Demo/Contract/Mint.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index 2ce6dca2f..a72b5cb55 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -56,6 +56,7 @@ library Mlabs.Data.Maybe Mlabs.Data.Ray Mlabs.Data.Ord + Mlabs.Demo.Contract.Mint Mlabs.Emulator.App Mlabs.Emulator.Blockchain Mlabs.Emulator.Scene @@ -192,6 +193,7 @@ Test-suite mlabs-plutus-use-cases-tests hs-source-dirs: test Main-is: Main.hs Other-modules: + Test.Demo.Contract.Mint Test.Lending.Contract Test.Lending.Init Test.Lending.Logic diff --git a/mlabs/src/Mlabs/Demo/Contract/Mint.hs b/mlabs/src/Mlabs/Demo/Contract/Mint.hs new file mode 100644 index 000000000..8e1c22e44 --- /dev/null +++ b/mlabs/src/Mlabs/Demo/Contract/Mint.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} + +module Mlabs.Demo.Contract.Mint + ( curPolicy + , getCurrencySymbol + , MintParams (..) + , MintSchema + , mintContract + , mintEndpoints + , swapEndpoints + ) where + +import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..)) + +import Plutus.Contract as Contract +import qualified Ledger as Ledger +import qualified Ledger.Ada as Ada +import qualified Ledger.Constraints as Constraints +import qualified Ledger.Contexts as V +import Ledger.Scripts +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value (TokenName, Value) +import qualified Ledger.Value as Value +import qualified PlutusTx as PlutusTx + +import Control.Monad +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.Map as Map +import Data.Semigroup (Last(..)) +import Data.Text +import Data.Void +import GHC.Generics (Generic) +import qualified PlutusTx.AssocMap as AssocMap +import Prelude (Semigroup(..)) +import qualified Prelude as Haskell +import Schema (ToSchema) +import Text.Printf + + +------------------------------------------------------------------------------- +-- Swap script +------------------------------------------------------------------------------- + +data SwapRedeemer = Deposit TokenName | Swap TokenName + +PlutusTx.unstableMakeIsData ''SwapRedeemer + +{-# INLINABLE mkSwapValidator #-} +mkSwapValidator :: () -> SwapRedeemer -> V.ScriptContext -> Bool +mkSwapValidator _ _ ctx = True +-- where +-- txInfo :: V.TxInfo +-- txInfo = V.scriptContextTxInfo ctx + +-- ownSymbol :: Value.CurrencySymbol +-- ownSymbol = V.ownCurrencySymbol ctx + +-- expectedForged :: Value +-- expectedForged = Value.singleton ownSymbol (tokenName md) (amount md + 10) + +-- forged :: Value +-- forged = V.txInfoForge txInfo + +-- where +-- ownInput :: V.TxOut +-- ownInput = case V.findOwnInput ctx of +-- Nothing -> traceError "input is missing" +-- Just i -> V.txInInfoResolved i + +-- feesPaid :: Bool +-- feesPaid = V.txOutValue ownInput == forged + +data Swapping +instance Scripts.ScriptType Swapping where + type DatumType Swapping = () + type RedeemerType Swapping = SwapRedeemer + + +swapInst :: Scripts.ScriptInstance Swapping +swapInst = Scripts.validator @Swapping + $$(PlutusTx.compile [|| mkSwapValidator ||]) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @() @SwapRedeemer + +swapValidator :: Validator +swapValidator = Scripts.validatorScript swapInst + +swapValHash :: Ledger.ValidatorHash +swapValHash = validatorHash swapValidator + +swapScrAddress :: Ledger.Address +swapScrAddress = Scripts.scriptAddress swapInst + +data SwapParams = SwapParams + { spBuyTokenName :: !TokenName + , spSellTokenName :: !TokenName + , spAmount :: !Integer + } + deriving (Generic, ToJSON, FromJSON, ToSchema) + + +type SwapSchema = + BlockchainActions + .\/ Endpoint "swap" SwapParams + +-- | Exchanges the specified amount of tokens at a 1 to 1 exchange rate. +swapContract :: SwapParams -> Contract w SwapSchema Text () +swapContract sp = do + pkh <- V.pubKeyHash <$> ownPubKey + let + buyTn = spBuyTokenName sp + sellTn = spSellTokenName sp + amt = spAmount sp + buyCs = getCurrencySymbol buyTn amt + sellCs = getCurrencySymbol sellTn amt + buyVal = getVal buyCs buyTn amt + sellVal = getVal sellCs sellTn amt + tx = + Constraints.mustPayToTheScript () sellVal + <> Constraints.mustPayToPubKey pkh buyVal + ledgerTx <- submitTxConstraints swapInst tx + void $ awaitTxConfirmed $ Ledger.txId ledgerTx + where + getVal cs tn amt + | cs == Ada.adaSymbol = Ada.lovelaceValueOf amt + | otherwise = Value.singleton cs tn amt + + +swapEndpoints :: Contract () SwapSchema Text () +swapEndpoints = mint >> swapEndpoints where mint = endpoint @"swap" >>= swapContract + + +------------------------------------------------------------------------------- +-- Minting script +------------------------------------------------------------------------------- + +{-# INLINABLE mkCurPolicy #-} +mkCurPolicy :: TokenName -> Integer -> V.ScriptContext -> Bool +mkCurPolicy tn amt ctx = traceIfFalse + "Value forged different from expected" + (expectedForged == forged) + where + txInfo :: V.TxInfo + txInfo = V.scriptContextTxInfo ctx + + ownSymbol :: Value.CurrencySymbol + ownSymbol = V.ownCurrencySymbol ctx + + expectedForged :: Value + expectedForged = Value.singleton ownSymbol tn amt + + forged :: Value + forged = V.txInfoForge txInfo + + +curPolicy :: TokenName -> Integer -> MonetaryPolicy +curPolicy tn amt = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| \tn amt -> Scripts.wrapMonetaryPolicy $ mkCurPolicy tn amt ||]) + `PlutusTx.applyCode` PlutusTx.liftCode tn + `PlutusTx.applyCode` PlutusTx.liftCode amt + +getCurrencySymbol :: TokenName -> Integer -> Ledger.CurrencySymbol +getCurrencySymbol tn amt = case tn of + "" -> Ada.adaSymbol + _ -> Ledger.scriptCurrencySymbol $ curPolicy tn amt + +data MintParams = MintParams + { mpTokenName :: !TokenName + , mpAmount :: !Integer + } + deriving (Generic, ToJSON, FromJSON, ToSchema) + + +type MintSchema = + BlockchainActions + .\/ Endpoint "mint" MintParams + +-- | Generates tokens with the specified name/amount and pays an equal amount +-- of Ada to the swap script. +mintContract :: MintParams -> Contract w MintSchema Text () +mintContract mp = do + let + tn = mpTokenName mp + amt = mpAmount mp + cs = getCurrencySymbol tn amt + payVal = Ada.lovelaceValueOf amt + forgeVal = Value.singleton cs tn amt + lookups = Constraints.monetaryPolicy $ curPolicy tn amt + tx = + Constraints.mustPayToOtherScript + swapValHash + (Datum $ PlutusTx.toData ()) + payVal + <> Constraints.mustForgeValue forgeVal + ledgerTx <- submitTxConstraintsWith @Void lookups tx + void $ awaitTxConfirmed $ Ledger.txId ledgerTx + +mintEndpoints :: Contract () MintSchema Text () +mintEndpoints = mint >> mintEndpoints where mint = endpoint @"mint" >>= mintContract + + diff --git a/mlabs/test/Test/Demo/Contract/Mint.hs b/mlabs/test/Test/Demo/Contract/Mint.hs new file mode 100644 index 000000000..6d163a0a3 --- /dev/null +++ b/mlabs/test/Test/Demo/Contract/Mint.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Test.Demo.Contract.Mint + ( test + ) where + +import Control.Lens +import Control.Monad hiding (fmap) +import Control.Monad.Freer.Extras as Extras +import Data.Default (Default(..)) +import qualified Data.Map as Map +import Data.Monoid (Last(..)) +import Ledger +import Ledger.Ada as Ada +import Ledger.Value +import Plutus.Contract.Test +import Plutus.Trace.Emulator as Emulator +import PlutusTx.Prelude +import Prelude (IO, Show(..), String) +import Test.Tasty + +import Mlabs.Demo.Contract.Mint + +test :: TestTree +test = checkPredicateOptions + (defaultCheckOptions & emulatorConfig .~ emCfg) + "mint trace" + ( walletFundsChange + (Wallet 1) + (Ada.lovelaceValueOf (-10_000_000) <> assetClassValue token 1000) + .&&. walletFundsChange + (Wallet 2) + (Ada.lovelaceValueOf (-50_000_000) <> assetClassValue token 50) + .&&. walletFundsChange + (Wallet 3) + (Ada.lovelaceValueOf 0 <> assetClassValue token 0) + ) + myTrace + +runMyTrace :: IO () +runMyTrace = runEmulatorTraceIO' def emCfg myTrace + +emCfg :: EmulatorConfig +emCfg = EmulatorConfig $ Left $ Map.fromList + [ (Wallet w, v) | w <- [1 .. 3] ] + where + v :: Value + v = Ada.lovelaceValueOf 100_000_000 + +usd :: TokenName +usd = "USD" + +curSymbol :: CurrencySymbol +curSymbol = getCurrencySymbol usd 0 + +token :: AssetClass +token = AssetClass (curSymbol, usd) + +myTrace :: EmulatorTrace () +myTrace = do + h1 <- activateContractWallet (Wallet 1) mintEndpoints + h2 <- activateContractWallet (Wallet 2) mintEndpoints + h3 <- activateContractWallet (Wallet 3) mintEndpoints + + callEndpoint @"mint" h1 MintParams { mpTokenName = usd, mpAmount = 10 } + void $ Emulator.waitNSlots 2 + + callEndpoint @"mint" h2 MintParams { mpTokenName = usd, mpAmount = 25 } + void $ Emulator.waitNSlots 2 + callEndpoint @"mint" h2 MintParams { mpTokenName = usd, mpAmount = 25 } + void $ Emulator.waitNSlots 2 + + callEndpoint @"mint" h3 MintParams { mpTokenName = usd, mpAmount = 0 } + void $ Emulator.waitNSlots 2 + + From 9031e53859372967f9adc4a37cd13eb474392d13 Mon Sep 17 00:00:00 2001 From: Neil Rutledge Date: Mon, 14 Jun 2021 10:09:48 -0400 Subject: [PATCH 59/81] Finalize minting/burning scripts and add tests --- mlabs/mlabs-plutus-use-cases.cabal | 1 + mlabs/src/Mlabs/Demo/Contract/Burn.hs | 57 ++++++++ mlabs/src/Mlabs/Demo/Contract/Mint.hs | 190 +++++++------------------- mlabs/test/Main.hs | 10 +- mlabs/test/Test/Demo/Contract/Mint.hs | 50 ++++--- 5 files changed, 141 insertions(+), 167 deletions(-) create mode 100644 mlabs/src/Mlabs/Demo/Contract/Burn.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index a72b5cb55..61f2e37da 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -56,6 +56,7 @@ library Mlabs.Data.Maybe Mlabs.Data.Ray Mlabs.Data.Ord + Mlabs.Demo.Contract.Burn Mlabs.Demo.Contract.Mint Mlabs.Emulator.App Mlabs.Emulator.Blockchain diff --git a/mlabs/src/Mlabs/Demo/Contract/Burn.hs b/mlabs/src/Mlabs/Demo/Contract/Burn.hs new file mode 100644 index 000000000..d10dbb492 --- /dev/null +++ b/mlabs/src/Mlabs/Demo/Contract/Burn.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} + +module Mlabs.Demo.Contract.Burn + ( burnScrAddress + , burnValHash + ) where + +import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..)) + +import qualified Ledger as Ledger +import Ledger.Contexts +import Ledger.Scripts +import qualified Ledger.Typed.Scripts as Scripts +import qualified PlutusTx as PlutusTx + +{-# INLINABLE mkValidator #-} +-- | A validator script that can be used to burn any tokens sent to it. +mkValidator :: () -> () -> ScriptContext -> Bool +mkValidator _ _ _ = False + +data Burning +instance Scripts.ScriptType Burning where + type DatumType Burning = () + type RedeemerType Burning = () + +burnInst :: Scripts.ScriptInstance Burning +burnInst = Scripts.validator @Burning + $$(PlutusTx.compile [|| mkValidator ||]) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @() @() + +burnValidator :: Validator +burnValidator = Scripts.validatorScript burnInst + +burnValHash :: Ledger.ValidatorHash +burnValHash = validatorHash burnValidator + +burnScrAddress :: Ledger.Address +burnScrAddress = Scripts.scriptAddress burnInst \ No newline at end of file diff --git a/mlabs/src/Mlabs/Demo/Contract/Mint.hs b/mlabs/src/Mlabs/Demo/Contract/Mint.hs index 8e1c22e44..4ede0bdac 100644 --- a/mlabs/src/Mlabs/Demo/Contract/Mint.hs +++ b/mlabs/src/Mlabs/Demo/Contract/Mint.hs @@ -6,6 +6,7 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -18,168 +19,88 @@ module Mlabs.Demo.Contract.Mint ( curPolicy - , getCurrencySymbol - , MintParams (..) - , MintSchema + , curSymbol , mintContract , mintEndpoints - , swapEndpoints + , MintParams (..) + , MintSchema ) where -import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..)) +import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..), null) import Plutus.Contract as Contract import qualified Ledger as Ledger import qualified Ledger.Ada as Ada import qualified Ledger.Constraints as Constraints -import qualified Ledger.Contexts as V +import Ledger.Contexts import Ledger.Scripts import qualified Ledger.Typed.Scripts as Scripts -import Ledger.Value (TokenName, Value) +import Ledger.Value (CurrencySymbol, TokenName) import qualified Ledger.Value as Value import qualified PlutusTx as PlutusTx import Control.Monad import Data.Aeson (FromJSON, ToJSON) -import qualified Data.Map as Map -import Data.Semigroup (Last(..)) -import Data.Text +import Data.Text hiding (all, filter, foldr) import Data.Void import GHC.Generics (Generic) -import qualified PlutusTx.AssocMap as AssocMap import Prelude (Semigroup(..)) -import qualified Prelude as Haskell import Schema (ToSchema) -import Text.Printf - - -------------------------------------------------------------------------------- --- Swap script -------------------------------------------------------------------------------- - -data SwapRedeemer = Deposit TokenName | Swap TokenName - -PlutusTx.unstableMakeIsData ''SwapRedeemer - -{-# INLINABLE mkSwapValidator #-} -mkSwapValidator :: () -> SwapRedeemer -> V.ScriptContext -> Bool -mkSwapValidator _ _ ctx = True --- where --- txInfo :: V.TxInfo --- txInfo = V.scriptContextTxInfo ctx - --- ownSymbol :: Value.CurrencySymbol --- ownSymbol = V.ownCurrencySymbol ctx - --- expectedForged :: Value --- expectedForged = Value.singleton ownSymbol (tokenName md) (amount md + 10) - --- forged :: Value --- forged = V.txInfoForge txInfo - --- where --- ownInput :: V.TxOut --- ownInput = case V.findOwnInput ctx of --- Nothing -> traceError "input is missing" --- Just i -> V.txInInfoResolved i - --- feesPaid :: Bool --- feesPaid = V.txOutValue ownInput == forged - -data Swapping -instance Scripts.ScriptType Swapping where - type DatumType Swapping = () - type RedeemerType Swapping = SwapRedeemer - -swapInst :: Scripts.ScriptInstance Swapping -swapInst = Scripts.validator @Swapping - $$(PlutusTx.compile [|| mkSwapValidator ||]) - $$(PlutusTx.compile [|| wrap ||]) - where - wrap = Scripts.wrapValidator @() @SwapRedeemer +import Mlabs.Demo.Contract.Burn -swapValidator :: Validator -swapValidator = Scripts.validatorScript swapInst +------------------------------------------------------------------------------ +-- On-chain code. -swapValHash :: Ledger.ValidatorHash -swapValHash = validatorHash swapValidator - -swapScrAddress :: Ledger.Address -swapScrAddress = Scripts.scriptAddress swapInst - -data SwapParams = SwapParams - { spBuyTokenName :: !TokenName - , spSellTokenName :: !TokenName - , spAmount :: !Integer - } - deriving (Generic, ToJSON, FromJSON, ToSchema) - - -type SwapSchema = - BlockchainActions - .\/ Endpoint "swap" SwapParams - --- | Exchanges the specified amount of tokens at a 1 to 1 exchange rate. -swapContract :: SwapParams -> Contract w SwapSchema Text () -swapContract sp = do - pkh <- V.pubKeyHash <$> ownPubKey - let - buyTn = spBuyTokenName sp - sellTn = spSellTokenName sp - amt = spAmount sp - buyCs = getCurrencySymbol buyTn amt - sellCs = getCurrencySymbol sellTn amt - buyVal = getVal buyCs buyTn amt - sellVal = getVal sellCs sellTn amt - tx = - Constraints.mustPayToTheScript () sellVal - <> Constraints.mustPayToPubKey pkh buyVal - ledgerTx <- submitTxConstraints swapInst tx - void $ awaitTxConfirmed $ Ledger.txId ledgerTx +{-# INLINABLE mkPolicy #-} +-- | A monetary policy that mints arbitrary tokens for an equal amount of Ada. +-- For simplicity, the Ada are sent to a burn address. +mkPolicy :: Ledger.Address -> ScriptContext -> Bool +mkPolicy burnAddr ctx = + traceIfFalse "Insufficient Ada paid" isPaid + && traceIfFalse "Forged amount is invalid" isForgeValid where - getVal cs tn amt - | cs == Ada.adaSymbol = Ada.lovelaceValueOf amt - | otherwise = Value.singleton cs tn amt + txInfo :: TxInfo + txInfo = scriptContextTxInfo ctx + outputs :: [TxOut] + outputs = txInfoOutputs txInfo -swapEndpoints :: Contract () SwapSchema Text () -swapEndpoints = mint >> swapEndpoints where mint = endpoint @"swap" >>= swapContract + forged :: [(CurrencySymbol, TokenName, Integer)] + forged = Value.flattenValue $ txInfoForge txInfo + forgedQty :: Integer + forgedQty = foldr (\(_, _, amt) acc -> acc + amt) 0 forged -------------------------------------------------------------------------------- --- Minting script -------------------------------------------------------------------------------- + isToBurnAddr :: TxOut -> Bool + isToBurnAddr o = txOutAddress o == burnAddr -{-# INLINABLE mkCurPolicy #-} -mkCurPolicy :: TokenName -> Integer -> V.ScriptContext -> Bool -mkCurPolicy tn amt ctx = traceIfFalse - "Value forged different from expected" - (expectedForged == forged) - where - txInfo :: V.TxInfo - txInfo = V.scriptContextTxInfo ctx + isPaid :: Bool + isPaid = + let + adaVal = + Ada.fromValue $ mconcat $ txOutValue <$> filter isToBurnAddr outputs + in Ada.getLovelace adaVal >= forgedQty * tokenToLovelaceXR - ownSymbol :: Value.CurrencySymbol - ownSymbol = V.ownCurrencySymbol ctx + isForgeValid :: Bool + isForgeValid = all isValid forged + where isValid (_, _, amt) = amt > 0 - expectedForged :: Value - expectedForged = Value.singleton ownSymbol tn amt - forged :: Value - forged = V.txInfoForge txInfo +curPolicy :: MonetaryPolicy +curPolicy = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . mkPolicy ||]) + `PlutusTx.applyCode` PlutusTx.liftCode burnScrAddress +curSymbol :: CurrencySymbol +curSymbol = Ledger.scriptCurrencySymbol curPolicy -curPolicy :: TokenName -> Integer -> MonetaryPolicy -curPolicy tn amt = mkMonetaryPolicyScript $ - $$(PlutusTx.compile [|| \tn amt -> Scripts.wrapMonetaryPolicy $ mkCurPolicy tn amt ||]) - `PlutusTx.applyCode` PlutusTx.liftCode tn - `PlutusTx.applyCode` PlutusTx.liftCode amt +-- For demo purposes, all tokens will be minted for a price of 1 Ada. +tokenToLovelaceXR :: Integer +tokenToLovelaceXR = 1_000_000 -getCurrencySymbol :: TokenName -> Integer -> Ledger.CurrencySymbol -getCurrencySymbol tn amt = case tn of - "" -> Ada.adaSymbol - _ -> Ledger.scriptCurrencySymbol $ curPolicy tn amt +------------------------------------------------------------------------------ +-- Off-chain code. data MintParams = MintParams { mpTokenName :: !TokenName @@ -187,25 +108,22 @@ data MintParams = MintParams } deriving (Generic, ToJSON, FromJSON, ToSchema) - type MintSchema = BlockchainActions .\/ Endpoint "mint" MintParams --- | Generates tokens with the specified name/amount and pays an equal amount --- of Ada to the swap script. +-- | Generates tokens with the specified name/amount and burns an equal amount of Ada. mintContract :: MintParams -> Contract w MintSchema Text () mintContract mp = do let tn = mpTokenName mp amt = mpAmount mp - cs = getCurrencySymbol tn amt - payVal = Ada.lovelaceValueOf amt - forgeVal = Value.singleton cs tn amt - lookups = Constraints.monetaryPolicy $ curPolicy tn amt + payVal = Ada.lovelaceValueOf $ amt * tokenToLovelaceXR + forgeVal = Value.singleton curSymbol tn amt + lookups = Constraints.monetaryPolicy curPolicy tx = Constraints.mustPayToOtherScript - swapValHash + burnValHash (Datum $ PlutusTx.toData ()) payVal <> Constraints.mustForgeValue forgeVal @@ -214,5 +132,3 @@ mintContract mp = do mintEndpoints :: Contract () MintSchema Text () mintEndpoints = mint >> mintEndpoints where mint = endpoint @"mint" >>= mintContract - - diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index cbf0ae64c..35dbdd480 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -3,10 +3,11 @@ module Main where import Test.Tasty import Test.Tasty.ExpectedFailure (ignoreTest) -import qualified Test.Lending.Contract as Lending.Contract -import qualified Test.Lending.Logic as Lending.Logic -import qualified Test.Nft.Logic as Nft.Logic -import qualified Test.Nft.Contract as Nft.Contract +import qualified Test.Demo.Contract.Mint as Demo.Contract.Mint +import qualified Test.Lending.Contract as Lending.Contract +import qualified Test.Lending.Logic as Lending.Logic +import qualified Test.Nft.Logic as Nft.Logic +import qualified Test.Nft.Contract as Nft.Contract main :: IO () main = defaultMain $ testGroup "tests" @@ -14,6 +15,7 @@ main = defaultMain $ testGroup "tests" , contract Nft.Contract.test ] , testGroup "Lending" [ Lending.Logic.test , contract Lending.Contract.test ] + , testGroup "Demo" [ Demo.Contract.Mint.test ] ] where contract diff --git a/mlabs/test/Test/Demo/Contract/Mint.hs b/mlabs/test/Test/Demo/Contract/Mint.hs index 6d163a0a3..6a6e104ae 100644 --- a/mlabs/test/Test/Demo/Contract/Mint.hs +++ b/mlabs/test/Test/Demo/Contract/Mint.hs @@ -18,17 +18,13 @@ module Test.Demo.Contract.Mint import Control.Lens import Control.Monad hiding (fmap) -import Control.Monad.Freer.Extras as Extras -import Data.Default (Default(..)) import qualified Data.Map as Map -import Data.Monoid (Last(..)) import Ledger import Ledger.Ada as Ada import Ledger.Value import Plutus.Contract.Test import Plutus.Trace.Emulator as Emulator import PlutusTx.Prelude -import Prelude (IO, Show(..), String) import Test.Tasty import Mlabs.Demo.Contract.Mint @@ -39,22 +35,18 @@ test = checkPredicateOptions "mint trace" ( walletFundsChange (Wallet 1) - (Ada.lovelaceValueOf (-10_000_000) <> assetClassValue token 1000) + (Ada.lovelaceValueOf (-15_000_000) <> assetClassValue usdToken 15) .&&. walletFundsChange (Wallet 2) - (Ada.lovelaceValueOf (-50_000_000) <> assetClassValue token 50) - .&&. walletFundsChange - (Wallet 3) - (Ada.lovelaceValueOf 0 <> assetClassValue token 0) + ( Ada.lovelaceValueOf (-50_000_000) + <> assetClassValue usdToken 20 + <> assetClassValue cadToken 30 + ) ) - myTrace - -runMyTrace :: IO () -runMyTrace = runEmulatorTraceIO' def emCfg myTrace + mintTrace emCfg :: EmulatorConfig -emCfg = EmulatorConfig $ Left $ Map.fromList - [ (Wallet w, v) | w <- [1 .. 3] ] +emCfg = EmulatorConfig $ Left $ Map.fromList [(Wallet 1, v), (Wallet 2, v)] where v :: Value v = Ada.lovelaceValueOf 100_000_000 @@ -62,27 +54,33 @@ emCfg = EmulatorConfig $ Left $ Map.fromList usd :: TokenName usd = "USD" -curSymbol :: CurrencySymbol -curSymbol = getCurrencySymbol usd 0 +cad :: TokenName +cad = "CAD" -token :: AssetClass -token = AssetClass (curSymbol, usd) +usdToken :: AssetClass +usdToken = AssetClass (curSymbol, usd) -myTrace :: EmulatorTrace () -myTrace = do +cadToken :: AssetClass +cadToken = AssetClass (curSymbol, cad) + +mintTrace :: EmulatorTrace () +mintTrace = do h1 <- activateContractWallet (Wallet 1) mintEndpoints h2 <- activateContractWallet (Wallet 2) mintEndpoints - h3 <- activateContractWallet (Wallet 3) mintEndpoints + -- Scenario 1: Buy single currency. + callEndpoint @"mint" h1 MintParams { mpTokenName = usd, mpAmount = 5 } + void $ Emulator.waitNSlots 2 callEndpoint @"mint" h1 MintParams { mpTokenName = usd, mpAmount = 10 } void $ Emulator.waitNSlots 2 - callEndpoint @"mint" h2 MintParams { mpTokenName = usd, mpAmount = 25 } + -- Scenario 2: Buy multiple currencies. + callEndpoint @"mint" h2 MintParams { mpTokenName = usd, mpAmount = 20 } void $ Emulator.waitNSlots 2 - callEndpoint @"mint" h2 MintParams { mpTokenName = usd, mpAmount = 25 } + callEndpoint @"mint" h2 MintParams { mpTokenName = cad, mpAmount = 30 } void $ Emulator.waitNSlots 2 - callEndpoint @"mint" h3 MintParams { mpTokenName = usd, mpAmount = 0 } - void $ Emulator.waitNSlots 2 + + From 715bf2045b3de4e0233e967c3709f0e8633ca68d Mon Sep 17 00:00:00 2001 From: Neil Rutledge Date: Mon, 21 Jun 2021 10:41:58 -0400 Subject: [PATCH 60/81] Add standards doc from Liqwid project --- STANDARDS.md | 995 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 995 insertions(+) create mode 100644 STANDARDS.md diff --git a/STANDARDS.md b/STANDARDS.md new file mode 100644 index 000000000..3ea4e1232 --- /dev/null +++ b/STANDARDS.md @@ -0,0 +1,995 @@ +# Introduction + +This document describes a set of standards for all code under the Plutus Use Cases +project. It also explains our reasoning for these choices, and acts as a living +document of our practices for current and future contributors to the project. We +intend for this document to evolve as our needs change, as well as act as a +single point of truth for standards. + +# Motivation + +The desired outcomes from the prescriptions in this document are as follows. + +## Increase consistency + +Inconsistency is worse than _any_ standard, as it requires us to track a large +amount of case-specific information. Software development is already a difficult +task due to the inherent complexities of the problems we seek to solve, as well +as the inherent complexities foisted upon us by _decades_ of bad historical +choices we have no control over. For newcomers to a project and old hands alike, +increased inconsistency translates to developmental friction, resulting in +wasted time, frustration and ultimately, worse outcomes for the code in +question. + +To avoid putting ourselves into this boat, both currently and in the future, we +must strive to be _automatically consistent_. Similar things should look +similar; different things should look different; as much as possible, we must +pick some rules _and stick to them_; and this has to be clear, explicit and +well-motivated. This will ultimately benefit us, in both the short and the long +term. The standards described here, as well as this document itself, is written +with this foremost in mind. + +## Limit non-local information + +There is a limited amount of space in a developer's skull; we all have bad days, +and we forget things or make decisions that, perhaps, may not be ideal at the +time. Therefore, limiting cognitive load is good for us, as it reduces the +amount of trouble we can inflict due to said skull limitations. One of the worst +contributors to cognitive load (after inconsistency) is _non-local information_ +- the requirement to have some understanding beyond the scope of the current +unit of work. That unit of work can be a data type, a module, or even a whole +project; in all cases, the more non-local information we require ourselves to +hold in our minds, the less space that leaves for actually doing the task at +hand, and the more errors we will introduce as a consequence. + +Thus, we must limit the need for non-local information at all possible levels. +'Magic' of any sort must be avoided; as much locality as possible must be +present everywhere; needless duplication of effort or result must be avoided. +Thus, our work must be broken down into discrete, minimal, logical units, which +can be analyzed, worked on, reviewed and tested in as much isolation as +possible. This also applies to our external dependencies. + +Thus, many of the decisions described here are oriented around limiting the +amount of non-local knowledge required at all levels of the codebase. +Additionally, we aim to avoid doing things 'just because we can' in a way that +would be difficult for other Haskellers to follow, regardless of skill level. + +## Minimize impact of legacy + +Haskell is a language that is older than some of the people currently writing +it; parts of its ecosystem are not exempt from it. With age comes legacy, and +much of it is based on historical decisions which we now know to be problematic +or wrong. We can't avoid our history, but we can minimize its impact on our +current work. + +Thus, we aim to codify good practices in this document _as seen today_. We also +try to avoid obvious 'sharp edges' by proscribing them away in a principled, +consistent and justifiable manner. + +## Automate away drudgery + +As developers, we should use our tools to make ourselves as productive as +possible. There is no reason for us to do a task if a machine could do it for +us, especially when this task is something boring or repetitive. We love Haskell +as a language not least of all for its capability to abstract, to describe, and +to make fun what other languages make dull or impossible; likewise, our work +must do the same. + +Many of the tool-related proscriptions and requirements in this document are +driven by a desire to remove boring, repetitive tasks that don't need a human to +perform. By removing the need for us to think about such things, we can focus on +those things which _do_ need a human; thus, we get more done, quicker. + +# Conventions + +The words MUST, SHOULD, MUST NOT, SHOULD NOT and MAY are defined as per [RFC +2119][rfc-2119]. + +# Tools + +## Compiler warning settings + +The following warnings MUST be enabled for all builds of any project, or any +project component: + +* ``-Wall`` +* ``-Wcompat`` +* ``-Wincomplete-uni-patterns`` +* ``-Wredundant-constraints`` +* ``-Werror`` + +Additionally, ``-Wincomplete-record-updates`` SHOULD be enabled for all builds +of any project. The only exception is when this warning would be spuriously +triggered by ``record-dot-preprocessor``, which occurs for definitions like +this: + +```haskell +data Foo = Bar { + baz :: Int, + quux :: String + } | + Quux +``` + +Additionally, ``-Wredundant-constraints`` SHOULD be enabled for all builds of +any project. Exceptions are allowed when the additional constraints are designed +to ensure safety, rather than due to reliance on any method. + +If a warning from this list is to be disabled, it MUST be disabled in the +narrowest possible scope; ideally, this SHOULD be a single module. + +### Justification + +These options are suggested by [Alexis King][alexis-king-options] - the +justifications for them can be found at the link. These fit well with our +motivations, and thus, should be used everywhere. The ``-Werror`` ensures that +warnings _cannot_ be ignored: this means that problems get fixed sooner. + +The two permissible exceptions stem from limitations in the record-dot plugin +(for ``-Wincomplete-record-updates``) and from the way redundant constraints are +detected; basically, unless a type class method from a constraint is used within +the body of the definition, or is required by anything called in a transitive +manner, the constraint is deemed redundant. Mostly, this is accurate, but some +type-level safety constraints can be deemed redundant as a result of this +approach. In this case, a limited lowering (per module ideally) of those two +warnings is acceptable, as they represent workarounds to technical problems, +rather than issues with the warnings themselves. + +## Linting + +Every source file MUST be free of warnings as produced by [HLint][hlint], with +default settings. + +### Justification + +HLint automates away the detection of many common sources of boilerplate and +inefficiency. It also describes many useful refactors, which in many cases make +the code easier to read and understand. As this is fully automatic, it saves +effort on our part, and ensures consistency across the codebase without us +having to think about it. + +## Code formatting + +Every source file MUST be formatted according to [Fourmolu][fourmolu], with the +following settings (as per its settings file): + +* ``indentation: 2`` +* ``comma-style: leading`` +* ``record-brace-space: true`` +* ``indent-wheres: true`` +* ``diff-friendly-import-export: true`` +* ``respectful: true`` +* ``haddock-style: multi-line`` +* ``newlines-between-decls: 1`` + +Each source code line MUST be at most 100 characters wide, and SHOULD +be at most 80 characters wide. + +### Justification + +Consistency is the most important goal of readable codebases. Having a single +standard, automatically enforced, means that we can be sure that everything will +look similar, and not have to spend time or mind-space ensuring that our code +complies. Additionally, as Ormolu is opinionated, anyone familiar with its +layout will find our code familiar, which eases the learning curve. + +Lines wider than 80 characters become difficult to read, especially when viewed +on a split screen. Sometimes, we can't avoid longer lines (especially with more +descriptive identifiers), but a line length of over 100 characters becomes +difficult to read even without a split screen. We don't _enforce_ a maximum of +80 characters for this exact reason; some judgment is allowed. + +# Code practices + +## Naming + +camelCase MUST be used for all non-type, non-data-constructor names; otherwise, +TitleCase MUST be used. Acronyms used as part of a naming identifier (such as +'JSON', 'API', etc) SHOULD be downcased; thus ``repairJson`` and +``fromHttpService`` are correct. Exceptions are allowed for external libraries +(Aeson's ``parseJSON`` for example). + +### Justification + +camelCase for non-type, non-data-constructor names is a long-standing convention +in Haskell (in fact, HLint checks for it); TitleCase for type names or data +constructors is _mandatory_. Obeying such conventions reduces cognitive load, as +it is common practice among the entire Haskell ecosystem. There is no particular +standard regarding acronym casing: examples of always upcasing exist (Aeson) as +well as examples of downcasing (``http-api-data``). One choice for consistency +(or as much as is possible) should be made however. + +## Modules + +All publically facing modules (namely, those which are not listed in +``other-modules`` in the Cabal file) MUST have explicit export lists. + +All modules MUST use one of the following conventions for imports: + +* ``import Foo (Baz, Bar, quux)`` +* ``import qualified Foo as F`` + +Data types from qualified-imported modules SHOULD be imported unqualified by +themselves: + +```haskell +import Data.Vector (Vector) +import qualified Data.Vector as Vector +``` + +The main exception is if such an import would cause a name clash: + +```haskell +-- no way to import both of these without clashing the Vector type name +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VStorable +``` + +The _sole_ exception is a 'hiding import' to replace part of the functionality +of ``Prelude``: + +```haskell +-- replace the String-based readFile with a Text-based one +import Prelude hiding (readFile) +import Data.Text.IO (readFile) +``` + +Data constructors SHOULD be imported individually. For example, given the +following data type declaration: + +```haskell +module Quux where + +data Foo = Bar Int | Baz +``` + +Its corresponding import should be: + +```haskell +import Quux (Foo, Bar, Baz) +``` + +For type class methods, the type class and its methods MUST be imported +as so: + +```haskell +import Data.Aeson (FromJSON (fromJSON)) +``` + +Qualified imports SHOULD use the entire module name (that is, the last component +of its hierarchical name) as the prefix. For example: + +```haskell +import qualified Data.Vector as Vector +``` + +Exceptions are granted when: + +* The import would cause a name clash anyway (such as different ``vector`` + modules); or +* We have to import a data type qualified as well. + +### Justification + +Explicit export lists are an immediate, clear and obvious indication of what +publically visible interface a module provides. It gives us stability guarantees +(namely, we know we can change things that aren't exported and not break +downstream code at compile time), and tells us where to go looking first when +inspecting or learning the module. Additionally, it means there is less chance +that implementation details 'leak' out of the module due to errors on the part +of developers, especially new developers. + +One of the biggest challenges for modules which depend on other modules +(especially ones that come from the project, rather than an external library) is +knowing where a given identifier's definition can be found. Having explicit +imports of the form described helps make this search as straightforward as +possible. This also limits cognitive load when examining the sources (if we +don't import something, we don't need to care about it in general). Lastly, +being explicit avoids stealing too many useful names. + +In general, type names occur far more often in code than function calls: we have +to use a type name every time we write a type signature, but it's unlikely we +use only one function that operates on said type. Thus, we want to reduce the +amount of extra noise needed to write a type name if possible. Additionally, +name clashes from function names are far more likely than name clashes from type +names: consider the number of types on which a ``size`` function makes sense. +Thus, importing type names unqualified, even if the rest of the module is +qualified, is good practice, and saves on a lot of prefixing. + +## Plutus module import naming conventions + +In addition to the general module import rules, we should follow some conventions on how we import the Plutus API modules, allowing for some flexibility depending on the needs of a particular module. + +Modules under the names `Plutus`, `Ledger` and `Plutus.V1.Ledger` SHOULD be imported qualified with their module name, as per the general module standards. An exception to this is `Plutus.V1.Ledger.Api`, where the `Ledger` name is preferred. + +Some other exceptions to this are allowed where it may be more convenient to avoid longer qualified names. + + +For example: + +```haskell +import Plutus.V1.Ledger.Slot qualified as Slot +import Plutus.V1.Ledger.Tx qualified as Tx +import Plutus.V1.Ledger.Api qualified as Ledger +import Ledger.Oracle qualified as Oracle +import Plutus.Contract qualified as Contract +``` + +In some cases it may be justified to use a shortened module name: + +```haskell +import Plutus.V1.Ledger.AddressMap qualified as AddrMap +``` + +Modules under `PlutusTx` that are extensions to `PlutusTx.Prelude` MAY be imported unqualified when it is reasonable to do so. + +The `Plutus.V1.Ledger.Api` module SHOULD be avoided in favour of more specific modules where possible. + +For example, we should avoid: + +```haskell +import Plutus.V1.Ledger.Api qualified as Ledger (ValidatorHash) +``` + +In favour of: + +```haskell +import Plutus.V1.Ledger.Scripts qualified as Scripts (ValidatorHash) +``` + +### Justification + +The Plutus API modules can be confusing, with numerous modules involved, many exporting the same items. + +Consistent qualified names help ease this problem, and decrease ambiguity about where imported items come from. + + +## LANGUAGE pragmata + +The following pragmata MUST be enabled at project level (that is, in +``package.yaml``): + +* ``BangPatterns`` +* ``BinaryLiterals`` +* ``ConstraintKinds`` +* ``DataKinds`` +* ``DeriveFunctor`` +* ``DeriveGeneric`` +* ``DeriveTraversable`` +* ``DerivingStrategies`` +* ``DuplicateRecordFields`` +* ``EmptyCase`` +* ``FlexibleContexts`` +* ``FlexibleInstances`` +* ``GADTs`` +* ``GeneralizedNewtypeDeriving`` +* ``HexFloatLiterals`` +* ``InstanceSigs`` +* ``ImportQualifiedPost`` +* ``KindSignatures`` +* ``LambdaCase`` +* ``MultiParamTypeClasses`` +* ``NoImplicitPrelude`` +* ``NumericUnderscores`` +* ``OverloadedStrings`` +* ``StandaloneDeriving`` +* ``TupleSections`` +* ``TypeApplications`` +* ``TypeOperators`` +* ``TypeSynonymInstances`` +* ``UndecidableInstances`` + +Any other LANGUAGE pragmata MUST be enabled per-file. All language pragmata MUST +be at the top of the source file, written as ``{-# LANGUAGE PragmaName #-}``. + +Furthermore, the following pragmata MUST NOT be used, or enabled, anywhere: + +* ``DeriveDataTypeable`` +* ``DeriveFoldable`` +* ``PartialTypeSignatures`` +* ``PostfixOperators`` + +### Justification + +``DataKinds``, ``DuplicateRecordFields``, ``GADTs``, ``TypeApplications``, +``TypeSynonymInstances`` and ``UndecidableInstances`` are needed globally to use +the GHC plugin from ``record-dot-preprocessor``. While some of these extensions +are undesirable to use globally, we end up needing them anyway, so we can't +really avoid this. + +``BangPatterns`` are a much more convenient way to force evaluation than +repeatedly using `seq`. Furthemore, they're not confusing, and are considered +ubiquitous enough for ``GHC2021``. Having them on by default simplifies a lot of +performance tuning work, and they don't really need signposting. + +``BinaryLiterals``, ``HexFloatLiterals`` and ``NumericUnderscores`` all simulate +features that are found in many other programming languages, and that are +extremely convenient in a range of settings, ranging from dealing with large +numbers to bit-twiddling. If anything, it is more surprising and annoying when +these _aren't_ enabled, and should really be part of Haskell syntax anyway. +Enabling this project-wide actually encourages better practice and readability. + +The kind ``Constraint`` is not in Haskell2010, and thus, isn't recognized by +default. While working with constraints as first-class objects isn't needed +often, this extension effectively exists because Haskell2010 lacks exotic kinds +altogether. Since we require explicit kind signatures (and foralls) for all type +variables, this needs to be enabled as well. There is no harm in enabling this +globally, as other rich kinds (such as ``Symbol`` or ``Nat``) don't require an +extension for their use, and this doesn't change any behaviour (``Constraint`` +exists whether you enable this extension or not, as do 'exotic kinds' in +general). + +``DerivingStrategies`` is good practice (and in fact, is mandated by this +document); it avoids ambiguities between ``GeneralizedNewtypeDeriving`` and +``DeriveAnyClass``, allows considerable boilerplate savings through use of +``DerivingVia``, and makes the intention of the derivation clear on immediate +reading, reducing the amount of non-local information about derivation +priorities that we have to retain. ``DeriveFunctor`` and +``GeneralizedNewtypeDeriving`` are both obvious and useful extensions to the +auto-derivation systems available in GHC. Both of these have only one correct +derivation (the former given by [parametricity +guarantees][functor-parametricity], the latter by the fact that a newtype only +wraps a single value). As there is no chance of unexpected behaviour by these, +no possible behaviour variation, and that they're key to supporting both the +``stock`` and ``newtype`` deriving stratgies, having these on by default removes +considerable tedium and line noise from our code. A good example are newtype +wrappers around monadic stacks: + +```haskell +newtype FooM a = FooM (ReaderT Int (StateT Text IO) a) + deriving newtype ( + Functor, + Applicative, + Monad, + MonadReader Int, + MonadState Text, + MonadIO + ) +``` + +Deriving ``Traversable`` is a little tricky. While ``Traversable`` is lawful +(though not to the degree ``Functor`` is, permitting multiple implementations in +many cases), deriving it is complicated by issues of role assignation for +higher-kinded type variables and the fact that you can't ``coerce`` through a +``Functor``. These are arguably implementation issues, but repairing this +situation requires cardinal changes to ``Functor``, which is unlikely to ever +happen. Even newtype or via derivations of ``Traversable`` are mostly +impossible; thus, we must have special support from GHC, which +``DeriveTraversable`` enables. This is a very historically-motivated +inconsistency, and should really not exist at all. While this only papers over +the problem (as even with this extension on, only stock derivations become +possible), it at least means that it can be done at all. Having it enabled +globally makes this inconsistency slightly less visible, and is completely safe. + +While GHC ``Generic``s are far from problem-free, many parts of the Haskell +ecosystem require ``Generic``, either as such (c.f. ``beam-core``) or for +convenience (c.f ``aeson``, ``hashable``). Additionally, several core parts of +Plutus (including ``ToSchema``) are driven by ``Generic``. The derivation is +trivial in most cases, and having to enable an extension for it is quite +annoying. Since no direct harm is done by doing this, and use of ``Generic`` is +already signposted clearly (and is mostly invisible), having this on globally +poses no problems. + +``EmptyCase`` not being on by default is an inconsistency of Haskell 2010, as +the report allows us to define an empty data type, but without this extension, +we cannot exhaustively pattern match on it. This should be the default behaviour +for reasons of symmetry. + +``FlexibleContexts`` and ``FlexibleInstances`` paper over a major deficiency of +Haskell2010, which in general isn't well-motivated. There is no real reason to +restrict type arguments to variables in either type class instances or type +signatures: the reasons for this choice in Haskell2010 are entirely for the +convenience of the implementation. It produces no ambiguities, and in many ways, +the fact this _isn't_ the default is more surprising than anything. +Additionally, many core libraries rely on one, or both, of these extensions +being enabled (``mtl`` is the most obvious example, but there are many others). +Thus, even for popularity and compatibility reasons, these should be on by +default. + +``InstanceSigs`` are harmless by default, and introduce no complications. Their +not being default is strange. ``ImportQualifiedPost`` is already a convention +of this project, and helps with formatting of imports. + +``KindSignatures`` become extremely useful in any setting where 'exotic kinds' +(meaning, anything which isn't `Type` or `Type -> Type` or similar) are +commonplace; much like type signatures clarify expectations and serve as active +documentation (even where GHC can infer them), explicit kind signatures serve +the same purpose 'one level up'. When combined with the requirement to provide +explicit foralls for type variables defined in this document, they simplify the +usage of 'exotic kinds' and provide additional help from both the type checker +and the code. Since this project is Plutus-based, we use 'exotic kinds' +extensively, especially in row-polymorphic records; thus, in our case, this is +especially important. This also serves as justification for +`ScopedTypeVariables`, as well as ironing out a weird behaviour where in cases +such as + +```haskell +foo :: a -> b +foo = bar . baz + where + bar :: String -> b + bar = ... + baz :: a -> String + baz = ... +``` + +cause GHC to produce _fresh_ type variables in each ``where``-bind. This is +confusing and makes little sense - if the user wanted a fresh variable, they +would name it that way. What's worse is that the type checker emits an error +that makes little sense (except to those who have learned to look for this +error), creating even more confusion, especially in cases where the type +variable is constrained: + +```haskell +foo :: (Monoid m) => m -> String +foo = bar . baz + where + baz :: m -> Int + baz = ... -- this has no idea that m is a Monoid, since m is fresh! +``` + +``LambdaCase`` reduces a lot of code in the common case of analysis of sum +types. Without it, we are forced to either write a dummy ``case`` argument: + +```haskell +foo s = case s of +-- rest of code here +``` + +Or alternatively, we need multiple heads: + +```haskell +foo Bar = -- rest of code +foo (Baz x y) = -- rest of code +-- etc +``` + +``LambdaCase`` is shorter than both of these, and avoids us having to bind +variables, only to pattern match them away immediately. It is convenient, clear +from context, and really should be part of the language to begin with. + +``MultiParamTypeClasses`` are required for a large number of standard Haskell +libraries, including ``mtl`` and ``vector``, and in many situations. Almost any +project of non-trivial size must have this extension enabled somewhere, and if +the code makes significant use of ``mtl``-style monad transformers or defines +anything non-trivial for ``vector``, it must use it. Additionally, it arguably +lifts a purely implementation-driven decision of the Haskell 2010 language, much +like ``FlexibleContexts`` and ``FlexibleInstances``. Lastly, although it can +introduce ambiguity into type checking, it only applies when we want to define +our own multi-parameter type classes, which is rarely necessary. Enabling it +globally is thus safe and convenient. + +Based on the recommendations of this document (driven by the needs of the +project and the fact it's cardinally connected with Plutus), +``NoImplicitPrelude`` is required to allow us to default to the Plutus prelude +instead of the one from ``base``. + +``OverloadedStrings`` deals with the problem that ``String`` is a suboptimal +choice of string representation for basically _any_ problem, with the general +recommendation being to use ``Text`` instead. It is not, however, without its +problems: + +* ``ByteString``s are treated as ASCII strings by their ``IsString`` instance; +* Overly polymorphic behaviour of many functions (especially in the presence of + type classes) forces extra type signatures; + +These are usually caused not by the extension itself, but by other libraries and +their implementations of either ``IsString`` or overly polymorphic use of type +classes without appropriate laws (Aeson's ``KeyValue`` is a particularly +egregious offender here). The convenience of this extension in the presence of +literals, and the fact that our use cases mostly covers ``Text``, makes it worth +using by default. + +``StandaloneDeriving`` is mostly needed for GADTs, or situations where complex +type-level computations drive type class instances, requiring users to specify +constraints manually. This can pose some difficulties syntactically (such as +with deriving strategies), but isn't a problem in and of itself, as it doesn't +really change how the language works. Having this enabled globally is not +problematic. + +``TupleSections`` smooths out an oddity in the syntax of Haskell 2010 regarding +partial application of tuple constructors. Given a function like ``foo :: Int -> String -> +Bar``, we accept it as natural that we can write ``foo 10`` to get a function of +type ``String -> Bar``. However, by default, this logic doesn't apply to tuple +constructors. As special cases are annoying to keep track of, and in this case, +serve no purpose, as well as being clear from their consistent use, this should +also be enabled by default; it's not clear why it isn't already. + +``TypeOperators`` is practically a necessity when dealing with type-level +programming seriously. Much how infix data constructors are extremely useful +(and sometimes clearer than their prefix forms), infix _type_ constructors serve +a similar functionality. Additionally, Plutus relies on operators at the type +level significantly - for example, it's not really possible to define a +row-polymorphic record or variant without them. Having to enable this almost +everywhere is a needless chore, and having type constructors behaving +differently to data constructors here is a needless source of inconsistency. + +We exclude ``DeriveDataTypeable``, as ``Data`` is a strictly-worse legacy +version of ``Generic``, and ``Typeable`` no longer needs deriving for anything +anyway. The only reason to derive either of these is for compatibility with +legacy libraries, which we don't have any of, and the number of which shrinks +every year. If we're using this extension at all, it's probably a mistake. + +``Foldable`` is possibly the most widely-used, lawless type class. Its only laws +are about self-consistency (such as agreement between ``foldMap`` and +``foldr``), but unlike something like ``Functor``, ``Foldable`` doesn't have any +laws specifying its behaviour outside of 'it compiles'. As a result, even if we +accept its usefulness (a debatable position in itself), there are large numbers +of possible implementations that could be deemed 'valid'. The approach taken by +``DeriveFoldable`` is _one_ such approach, but this requires knowing its +derivation algorithm, and may well not be something you need. Unlike a +``Functor`` derivation (whose meaning is obvious), a ``Foldable`` one is +anything but, and requires referencing a lot of non-local information to +determine how it will behave (especially for the 'richer' ``Foldable``, with +many additional methods). If you need a ``Foldable`` instance, you will either +newtype or via-derive it (which doesn't need this extension anyway), or you'll +write your own (which _also_ doesn't need this extension). Enabling this +encourages bad practices, is confusing, and ultimately doesn't really benefit +anything. + +``PartialTypeSignatures`` is a misfeature. Allowing leaving in type holes (to be +filled by GHC's inference algorithm) is an anti-pattern for the same reason that +not providing top-level signatures: while it's possible (mostly) for GHC to +infer signatures, we lose considerable clarity and active documentation by doing +so, in return for (quite minor) convenience. While the use of typed holes during +development is a good practice, they should not remain in final code. Given that +Plutus projects require us to do some fairly advanced type-level programming +(where inference often _fails_), this extension can often provide totally +incorrect results due to GHC's 'best-effort' attempts at type checking. There is +no reason to leave behind typed holes instead of filling them in, and we +shouldn't encourage this. + +``PostfixOperators`` are arguably a misfeature. Infix operators already require +a range of special cases to support properly (what symbols create an infix +operator, importing them at the value and type level, etc), which postfix +operators make _worse_. Furthermore, they are seldom, if ever, used, and +typically aren't worth the trouble. Haskell is not Forth, none of our +dependencies rely on postfix operators, and defining our own creates more +problems than it solves. + +## ``record-dot-preprocessor`` + +The GHC plugin from ``record-dot-preprocessor`` SHOULD be enabled globally. + +### Justification + +Haskell records are documentedly and justifiably subpar: the [original issue for +the record dot preprocessor extension][rdp-issue] provides a good summary of the +reasons. While a range of extensions (including ``DuplicateRecordFields``, +``DisambiguateRecordFields``, ``NamedFieldPuns``, and many others) have been +proposed, and accepted, to mitigate the situation, the reality is that, even +with them in place, use of records in Haskell is considerably more difficult, +and less flexible, than in any other language in widespread use today. The +proposal described in the previous link provides a solution which is familiar to +users of most other languages, and addresses the fundamental issue that makes +Haskell records so awkward. + +While the proposal for the record dot syntax that this preprocessor enables is +coming, it's not available in the current version of Haskell used by Plutus (and +thus, transitively, by us). Additionally, the earliest this will be available is +GHC 9.2, and given that our dependencies must support this version too, it'll be +considerable time before we can get its benefits. The preprocessor gives us +these benefits immediately, at some dependency cost. While it's not a perfect +process, as it involves enabling several questionable extensions, and can +require disabling an important warning, it significantly reduces issues with +record use, making it worthwhile. Additionally, when GHC 9.2 becomes usable, we +can upgrade to it seamlessly. + +## Prelude + +The ``PlutusTx.Prelude`` MUST be used. A 'hiding import' to remove functionality +we want to replace SHOULD be used when necessary. If functionality from the +``Prelude`` in ``base`` is needed, it SHOULD be imported qualified. Other +preludes MUST NOT be used. + +### Justification + +As this is primarily a Plutus project, we are in some ways limited by what +Plutus requires (and provides). Especially for on-chain code, the Plutus prelude +is the one we need to use, and therefore, its use should be as friction-free as +possible. As many modules may contain a mix of off-chain and on-chain code, we +also want to make impendance mismatches as limited as possible. + +By the very nature of this project, we can assume a familiarity (or at least, +the goal of such) with Plutus stuff. Additionally, _every_ Haskell developer is +familiar with the ``Prelude`` from ``base``. Thus, any replacements of the +Plutus prelude functionality with the ``base`` prelude should be clearly +indicated locally. + +Haskell is a 30-year-old language, and the ``Prelude`` is one of its biggest +sources of legacy. A lot of its defaults are questionable at best, and often +need replacing. As a consequence of this, a range of 'better ``Prelude``s' have +been written, with a range of opinions: while there is a common core, a large +number of decisions are opinionated in ways more appropriate to the authors of +said alternatives and their needs than those of other users of said +alternatives. This means that, when a non-``base`` ``Prelude`` is in scope, it +often requires familiarity with its specific decisions, in addition to whatever +cognitive load the current module and its other imports impose. Given that we +already use an alternative prelude (in tandem with the one from ``base``), +additional alternatives present an unnecessary cognitive load. Lastly, the +dependency footprint of many alternative ``Prelude``s is _highly_ non-trivial; +it isn't clear if we need all of this in our dependency tree. + +For all of the above reasons, the best choice is 'default to Plutus, with local +replacements from `base`'. + +## Versioning + +A project MUST use the [PVP][pvp]. Two, and only two, version numbers MUST be +used: a major version and a minor version. + +### Justification + +The [Package Versioning Policy][pvp] is the conventional Haskell versioning +scheme, adopted by most packages on Hackage. It is clearly described, and even +automatically verifiable by use of tools like [``policeman``][policeman]. Thus, +adopting it is both in line with community standards (making it easier to +remember), and simplifies cases such as Hackage publication or open-sourcing in +general. + +Two version numbers (major and minor) is the minimum allowed by the PVP, +indicating compilation-breaking and compilation-non-breaking changes +respectively. As parsimony is best, and more granularity than this isn't +generally necessary, adopting this model is the right decision. + +## Documentation + +Every publically-exported definition MUST have a Haddock comment, detailing its +purpose. If a definition is a function, it SHOULD also have examples of use +using [Bird tracks][bird-tracks]. The Haddock for a publically-exported +definition SHOULD also provide an explanation of any caveats, complexities of +its use, or common issues a user is likely to encounter. + +If the code project is a library, these Haddock comments SHOULD carry an +[``@since``][haddock-since] annotation, stating what version of the library they +were introduced in, or the last version where their functionality or type +signature changed. + +For type classes, their laws MUST be documented using a Haddock comment. + +### Justification + +Code reading is a difficult task, especially when the 'why' rather than the +'how' of the code needs to be deduced. A good solution to this is documentation, +especially when this documentation specifies common issues, provides examples of +use, and generally states the rationale behind the definition. + +For libraries, it is often important to inform users what changed in a given +version, especially where 'major bumps' are concerned. While this would ideally +be addressed with accurate changelogging, it can be difficult to give proper +context. ``@since`` annotations provide a granular means to indicate the last +time a definition changed considerably, allowing someone to quickly determine +whether a version change affects something they are concerned with. + +As stated elsewhere in the document, type classes having laws is critical to our +ability to use equational reasoning, as well as a clear indication of what +instances are and aren't permissible. These laws need to be clearly stated, as +this assists both those seeking to understand the purpose of the type class, and +also the expected behaviour of its instances. + +## Other + +Lists SHOULD NOT be field values of types; this extends to ``String``s. Instead, +``Vector``s (``Text``s) SHOULD be used, unless a more appropriate structure exists. +On-chain code, due to a lack of alternatives, is one place lists can be used as +field values of types. + +Partial functions MUST NOT be defined. Partial functions SHOULD NOT be used +except to ensure that another function is total (and the type system cannot be +used to prove it). + +Derivations MUST use an explicit [strategy][deriving-strategies]. Thus, the +following is wrong: + +```haskell +newtype Foo = Foo (Bar Int) + deriving (Eq, Show, Generic, FromJSON, ToJSON, Data, Typeable) +``` + +Instead, write it like this: + +```haskell +newtype Foo = Foo (Bar Int) + deriving stock (Generic, Data, Typeable) + deriving newtype (Eq, Show) + deriving anyclass (FromJSON, ToJSON) +``` + +Deriving via SHOULD be preferred to newtype derivation, especially where the +underlying type representation could change significantly. + +``type`` SHOULD NOT be used. The only acceptable case is abbreviation of large +type-level computations. In particular, using ``type`` to create an abstraction +boundary MUST NOT be done. + +Type variables MUST have an explicit ``forall`` scoping it, and all type +variables MUST have kind signatures explicitly provided. Thus, the following is +wrong: + +```haskell +data Foo a = Bar | Baz [a] + +quux :: (Monoid m) => [m] -> m -> m +``` + +Instead, write it like this: + +```haskell +data Foo (a :: Type) = Bar | Baz [a] + +quux :: forall (m :: Type) . (Monoid m) => [m] -> m -> m +``` + +### Justification + +Haskell lists are a large example of the legacy of the language: they (in the +form of singly linked lists) have played an important role in the development of +functional programming (and for some 'functional' languages, continue to do so). +However, from the perspective of data structures, they are suboptimal except for +_extremely_ specific use cases. In almost any situation involving data (rather +than control flow), an alternative, better structure exists. Although it is both +acceptable and efficient to use lists within functions (due to GHC's extensive +fusion optimizations), from the point of view of field values, they are a poor +choice from both an efficiency perspective, both in theory _and_ in practice. +For almost all cases where you would want a list field value, a ``Vector`` field +value is more appropriate, and in almost all others, some other structure (such +as a ``Map``) is even better. + +Partial functions are runtime bombs waiting to explode. The number of times the +'impossible' happened, especially in production code, is significant in our +experience, and most partiality is easily solvable. Allowing the compiler to +support our efforts, rather than being blind to them, will help us write more +clear, more robust, and more informative code. Partiality is also an example of +legacy, and it is legacy of _considerable_ weight. Sometimes, we do need an +'escape hatch' due to the impossibility of explaining what we want to the +compiler; this should be the _exception_, not the rule. + +Derivations are one of the most useful features of GHC, and extend the +capabilities of Haskell 2010 considerably. However, with great power comes great +ambiguity, especially when ``GeneralizedNewtypeDeriving`` is in use. While there +_is_ an unambiguous choice if no strategy is given, it becomes hard to remember. +This is especially dire when ``GeneralizedNewtypeDeriving`` combines with +``DeriveAnyClass`` on a newtype. Explicit strategies give more precise control +over this, and document the resulting behaviour locally. This reduces the number +of things we need to remember, and allows more precise control when we need it. +Lastly, in combination with ``DerivingVia``, considerable boilerplate can be +saved; in this case, explicit strategies are _mandatory_. + +The only exception to the principle above is newtype deriving, which can +occasionally cause unexpected problems; if we use a newtype derivation, and +change the underlying type, we get no warning. Since this can affect the effect +of some type classes drastically, it would be good to have the compiler check +our consistency. + +``type`` is generally a terrible idea in Haskell. You don't create an +abstraction boundary with it (any operations on the 'underlying type' still work +over it), and compiler output becomes _very_ inconsistent (sometimes showing the +``type`` definition, sometimes the underlying type). If your goal is to create +an abstraction boundary with its own operations, ``newtype`` is both cost-free +and clearer; if that is _not_ your goal, just use the type you'd otherwise +rename, since it's equivalent semantically. The only reasonable use of ``type`` +is to hide complex type-level computations, which would otherwise be too long. +Even this is somewhat questionable, but the questionability comes from the +type-level computation being hidden, not ``type`` as such. + +Type-level programming is mandated in many places by Plutus (including, but not +limited to, row-polymorphic records and variants from `Data.Row`). This often +requires use of ``TypeApplications``, which essentially makes not only the type +variables, but their _order_, part of the API of any definition that uses them. +While there is an algorithm determining this precisely, something that is +harmless at the value level (such as re-ordering constraints) could potentially +serve as an API break. Additionally, this algorithm is a huge source of +non-local information, and in the presence of a large number of type variables, +of different kinds, can easily become confusing. Having explicit foralls +quantifying all type variables makes it clear what the order for these type +variables is for ``TypeApplications``, and also allows us to choose it +optimally for our API, rather than relying on what the algorithm would produce. +This is significantly more convenient, and means less non-local information and +confusion. + +Additionally, type-level programming requires significant use of 'exotic kinds', +which in our case include ``Constraint -> Type`` and ``Row Type``, to name but a +few. While GHC can (mostly) infer kind signatures, much the same way as we +explicitly annotate type signatures as a form of active documentation (and to +assist the type checker when using type holes), explicitly annotating _kind_ +signatures allows us to be clear to the users where exotic kinds are expected, +as well as ensuring that we don't make any errors ourselves. This, together with +explicit foralls, essentially bring the same practices to the kind level as the +Haskell community already considers to be good at the type level. + +# Design practices + +## Parse, don't validate + +[Boolean blindness][boolean-blindness] SHOULD NOT be used in the design of any +function or API. Returning more meaningful data SHOULD be the preferred choice. +The general principle of ['parse, don't validate'][parse-dont-validate] SHOULD +guide design and implementation. + +### Justification + +The [description of boolean blindness][boolean-blindness] gives specific reasons why it is a poor +design choice; additionally, it runs counter to the principle of ['parse, don't +validate][parse-dont-validate]. While sometimes unavoidable, in many cases, it's +possible to give back a more meaningful response than 'yes' or 'no, and we +should endeavour to do this. Designs that avoid boolean blindness are more +flexible, less bug-prone, and allow the type checker to assist us when writing. +This, in turn, reduces cognitive load, improves our ability to refactor, and +means fewer bugs from things the compiler _could_ have checked if a function +_wasn't_ boolean-blind. + +## No multi-parameter type-classes without functional dependencies + +Any multi-parameter type class MUST have a functional dependency restricting its +relation to a one-to-many at most. In cases of true many-to-many relationships, +type classes MUST NOT be used as a solution to the problem. + +### Justification + +Multi-parameter type classes allow us to express more complex relationships +among types; single-parameter type classes effectively permit us to 'subset' +``Hask`` only. However, multi-parameter type classes make type inference +_extremely_ flakey, as the global coherence condition can often lead to the +compiler being unable to determine what instance is sought even if all the type +parameters are concrete, due to anyone being able to add a new instance at any +time. This is largely caused by multi-parameter type classes defaulting to +effectively representing arbitrary many-to-many relations. + +When we do not _have_ arbitrary many-to-many relations, multi-parameter type +classes are useful and convenient. We can indicate this using functional +dependencies, which inform the type checker that our relationship is not +arbitrarily many-to-many, but rather many-to-one or even one-to-one. This is a +standard practice in many libraries (``mtl`` being the most ubiquitous example), +and allows us the benefits of multi-parameter type classes without making type +checking confusing and difficult. + +In general, many-to-many relationships pose difficult design choices, for which +type classes are _not_ the correct solution. If a functional dependency _cannot_ +be provided for a type class, it suggests that the current design relies +inherently on a many-to-many relation, and should be either rethought to +eliminate it, or be dealt with using a more appropriate means. + +## Type classes must have laws + +Any type class not imported from an external dependency MUST have laws. These +laws MUST be documented in a Haddock comment on the type class definition, and +all instances MUST follow these laws. + +### Justification + +Type classes are a powerful feature of Haskell, but can also be its most +confusing. As they allow arbitrary ad-hoc polymorphism, and are globally +visible, it is important that we limit the confusion this can produce. +Additionally, type classes without laws inhibit equational reasoning, which is +one of Haskell's biggest strengths, _especially_ in the presence of what amounts +to arbitrary ad-hoc polymorphism. + +Additionally, type classes with laws allow the construction of _provably_ +correct abstractions above them. This is also a common feature in Haskell, +ranging from profunctor optics to folds. If we define our own type classes, we +want to be able to abstract above them with _total_ certainty of correctness. +Lawless type classes make this difficult to do: compare the number of +abstractions built on `Functor` or `Traversable` as opposed to `Foldable`. + +Thus, type classes having laws provides both ease of understanding and +additional flexibility. + +[pvp]: https://pvp.haskell.org/ +[policeman]: https://hackage.haskell.org/package/policeman +[haddock-since]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#since +[bird-tracks]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#code-blocks +[hedgehog-classes]: http://hackage.haskell.org/package/hedgehog-classes +[hspec-hedgehog]: http://hackage.haskell.org/package/hspec-hedgehog +[property-based-testing]: https://dl.acm.org/doi/abs/10.1145/1988042.1988046 +[hedgehog]: http://hackage.haskell.org/package/hedgehog +[deriving-strategies]: https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/deriving-strategies +[functor-parametricity]: https://www.schoolofhaskell.com/user/edwardk/snippets/fmap +[alexis-king-options]: https://lexi-lambda.github.io/blog/2018/02/10/an-opinionated-guide-to-haskell-in-2018/#warning-flags-for-a-safe-build +[hlint]: http://hackage.haskell.org/package/hlint +[fourmolu]: http://hackage.haskell.org/package/fourmolu +[rfc-2119]: https://tools.ietf.org/html/rfc2119 +[boolean-blindness]: http://dev.stephendiehl.com/hask/#boolean-blindness +[parse-dont-validate]: https://lexi-lambda.github.io/blog/2019/11/05/parse-don-t-validate/ +[hspec]: http://hackage.haskell.org/package/hspec +[rdp]: https://hackage.haskell.org/package/record-dot-preprocessor +[rdp-issue]: https://github.com/ghc-proposals/ghc-proposals/pull/282 From e765abc2c9af40871c04326fbed1b6f741321182 Mon Sep 17 00:00:00 2001 From: Jozef Koval Date: Mon, 21 Jun 2021 23:46:22 +0200 Subject: [PATCH 61/81] Update intendation, support more shells. --- mlabs/Makefile | 4 ++-- mlabs/nft-demo/Main.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/mlabs/Makefile b/mlabs/Makefile index 6d0f3a151..620a64ee0 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -19,6 +19,6 @@ test-watch: # Target to use as dependency to fail if not inside nix-shell requires_nix_shell: - @ [ -v IN_NIX_SHELL ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" - @ [ -v IN_NIX_SHELL ] || (echo " run 'nix-shell --pure' first" && false) + @ [ "($IN_NIX_SHELL)" ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" + @ [ "($IN_NIX_SHELL)" ] || (echo " run 'nix-shell --pure' first" && false) diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index 2d43ad863..5f84c087f 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -30,7 +30,7 @@ main = runSimulator startParams $ do nid <- activateStartNft user1 cids <- mapM (activateUser nid) [user1, user2, user3] - let [u1, u2, u3] = cids + let [u1, u2, u3] = cids test "User 1 sets the Mona Lisa's price to 100 Lovelace, User 2 buys The Mona Lisa from User 1 for 100 Lovelace (what a deal!), User 2 has specified that the Mona Lisa is not for sale" [1, 2] $ do setPrice u1 (Just 100) From b234601bb2631dad084ba12c26ad011d78a95de4 Mon Sep 17 00:00:00 2001 From: Oleg Prutz Date: Tue, 22 Jun 2021 17:37:03 +0300 Subject: [PATCH 62/81] Fix typo --- mlabs/nft-demo/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index 2d43ad863..5f84c087f 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -30,7 +30,7 @@ main = runSimulator startParams $ do nid <- activateStartNft user1 cids <- mapM (activateUser nid) [user1, user2, user3] - let [u1, u2, u3] = cids + let [u1, u2, u3] = cids test "User 1 sets the Mona Lisa's price to 100 Lovelace, User 2 buys The Mona Lisa from User 1 for 100 Lovelace (what a deal!), User 2 has specified that the Mona Lisa is not for sale" [1, 2] $ do setPrice u1 (Just 100) From 2667bd9f6917cbf0ef5491c761dcb22d0c5ccb37 Mon Sep 17 00:00:00 2001 From: Jozef Koval Date: Mon, 21 Jun 2021 23:46:22 +0200 Subject: [PATCH 63/81] Update intendation, support more shells. --- mlabs/Makefile | 4 ++-- mlabs/nft-demo/Main.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/mlabs/Makefile b/mlabs/Makefile index 6d0f3a151..620a64ee0 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -19,6 +19,6 @@ test-watch: # Target to use as dependency to fail if not inside nix-shell requires_nix_shell: - @ [ -v IN_NIX_SHELL ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" - @ [ -v IN_NIX_SHELL ] || (echo " run 'nix-shell --pure' first" && false) + @ [ "($IN_NIX_SHELL)" ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" + @ [ "($IN_NIX_SHELL)" ] || (echo " run 'nix-shell --pure' first" && false) diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index 2d43ad863..5f84c087f 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -30,7 +30,7 @@ main = runSimulator startParams $ do nid <- activateStartNft user1 cids <- mapM (activateUser nid) [user1, user2, user3] - let [u1, u2, u3] = cids + let [u1, u2, u3] = cids test "User 1 sets the Mona Lisa's price to 100 Lovelace, User 2 buys The Mona Lisa from User 1 for 100 Lovelace (what a deal!), User 2 has specified that the Mona Lisa is not for sale" [1, 2] $ do setPrice u1 (Just 100) From 5f60c000695f36407d2c88c9d5578828d13df843 Mon Sep 17 00:00:00 2001 From: cstml Date: Wed, 23 Jun 2021 10:13:10 +0100 Subject: [PATCH 64/81] update: added README TOC generation to makefile --- mlabs/Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mlabs/Makefile b/mlabs/Makefile index 620a64ee0..e2945d454 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -22,3 +22,5 @@ requires_nix_shell: @ [ "($IN_NIX_SHELL)" ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" @ [ "($IN_NIX_SHELL)" ] || (echo " run 'nix-shell --pure' first" && false) +readme_contents: + nix-shell -p nodePackages.npm --command "npx markdown-toc ./README.md --no-firsth1" From 0bef02bf76d1457b289507982ad4e4670ffbcede Mon Sep 17 00:00:00 2001 From: cstml Date: Wed, 23 Jun 2021 10:13:44 +0100 Subject: [PATCH 65/81] init: created README with initial structure --- mlabs/README.md | 122 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 122 insertions(+) create mode 100644 mlabs/README.md diff --git a/mlabs/README.md b/mlabs/README.md new file mode 100644 index 000000000..2006fb56d --- /dev/null +++ b/mlabs/README.md @@ -0,0 +1,122 @@ +# MLabs: Plutus Use Cases +-------------------------------------------------------------------------------- +## Contents + +- [Contents](#contents) +- [Overview](#overview) + * [Prerequisites](#prerequisites) + * [Building, Testing, Use](#building-testing-use) + * [Documentation](#documentation) + * [Testing](#testing) +- [Use Case: Lendex](#use-case-lendex) + * [Description](#description) + * [Progress & Planning](#progress--planning) + * [Examples](#examples) + * [APIs & Endpoints](#apis--endpoints) + * [Notes](#notes) +- [Use Case: NFT](#use-case-nft) + * [Description](#description-1) + * [Progress & Planning](#progress--planning-1) + * [Examples](#examples-1) + * [APIs & Endpoints](#apis--endpoints-1) + * [Notes](#notes-1) + +*note: the table of contents is generated using `make readme_contents`. please +update as headings are expanded.* + +## Overview + +MLabs has been working on developing two Plutus Use cases, specifically: +- [Use Case: Lendex](#use-case-lendex) +- [Use Case: NFT](#use-case-nft) + +### Prerequisites + +- List all dependencies, like `nix` etc. + +### Building, Testing, Use + +*Add step by step instructions on how to build, test and use the software.* + +1. Clone the repo and run `make` +2. ... + +### Documentation + +Currently the documentation is done via this document which can +be found in the [MLabs gitHub repository](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs) + +### Testing +For an overview of the tests refer to the [test folder](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs/test) + +-------------------------------------------------------------------------------- +## Use Case: Lendex + +### Description +*Small description/summary* + +### Progress & Planning +- Goals and status: *add tasks and goals + their status* + - Development + - [x] *task 1(Done)* + - [ ] *task 2(WIP)* + + - Testing + - [ ] 50% Test Coverage + - [ ] 100% Test Coverage + - [ ] QuickCheck Testing + + - Documentation + - [ ] Document Examples + +### Examples +- [Lendex Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/lendex-demo/Main.hs) +- *Add any other relevant examples* + +### APIs & Endpoints + +- **API/Endpoint Name1** + - Description: *Add Description* + - Develop/use: *Specify if using or developing the API/Endpoint* + +- **API/Endpoint Name2** + - Description: *Add Description* + - Develop/use: *Specify if using or developing the API/Endpoint* + +### Notes +*Add any relevant notes* + +-------------------------------------------------------------------------------- +## Use Case: NFT + +### Description +*Small description/summary* + +### Progress & Planning +- Goals and status: *add tasks and goals + their status* + - Development + - [x] *task 1(Done)* + - [ ] *task 2(WIP)* + + - Testing + - [ ] 50% Test Coverage + - [ ] 100% Test Coverage + - [ ] QuickCheck Testing + + - Documentation + - [ ] Document Examples + +### Examples +- [NFT Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/nft-demo/Main.hs) + +### APIs & Endpoints +- **API/Endpoint Name1** + - Description: *Add Description* + - Develop/use: *Specify if using or developing the API/Endpoint* + +- **API/Endpoint Name2** + - Description: *Add Description* + - Develop/use: *Specify if using or developing the API/Endpoint* + +### Notes +*Add any relevant notes* From 95de4f8a547e6a0c1af73d526c91175047abb5c8 Mon Sep 17 00:00:00 2001 From: cstml Date: Wed, 23 Jun 2021 11:38:17 +0100 Subject: [PATCH 66/81] update: added description to --- mlabs/Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/mlabs/Makefile b/mlabs/Makefile index e2945d454..c86b1ffd4 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -22,5 +22,7 @@ requires_nix_shell: @ [ "($IN_NIX_SHELL)" ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" @ [ "($IN_NIX_SHELL)" ] || (echo " run 'nix-shell --pure' first" && false) +# Generate TOC for README.md +# It has to be manually inserted into the README.md for now. readme_contents: nix-shell -p nodePackages.npm --command "npx markdown-toc ./README.md --no-firsth1" From c59726ad6264d33bfdb02dfb25ac819f998f1244 Mon Sep 17 00:00:00 2001 From: Neil Rutledge Date: Wed, 23 Jun 2021 11:23:41 -0400 Subject: [PATCH 67/81] Update STANDARDS doc with latest changes from Koz --- STANDARDS.md | 60 ++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 46 insertions(+), 14 deletions(-) diff --git a/STANDARDS.md b/STANDARDS.md index 3ea4e1232..4f33b859f 100644 --- a/STANDARDS.md +++ b/STANDARDS.md @@ -269,6 +269,14 @@ Exceptions are granted when: modules); or * We have to import a data type qualified as well. +Qualified imports of multiple modules MUST NOT be imported under the same name. +Thus, the following is wrong: + +```haskell +import qualified Foo.Bar as Baz +import qualified Foo.Quux as Baz +``` + ### Justification Explicit export lists are an immediate, clear and obvious indication of what @@ -298,12 +306,16 @@ qualified, is good practice, and saves on a lot of prefixing. ## Plutus module import naming conventions -In addition to the general module import rules, we should follow some conventions on how we import the Plutus API modules, allowing for some flexibility depending on the needs of a particular module. - -Modules under the names `Plutus`, `Ledger` and `Plutus.V1.Ledger` SHOULD be imported qualified with their module name, as per the general module standards. An exception to this is `Plutus.V1.Ledger.Api`, where the `Ledger` name is preferred. +In addition to the general module import rules, we follow some conventions +on how we import the Plutus API modules, allowing for some flexibility +depending on the needs of a particular module. -Some other exceptions to this are allowed where it may be more convenient to avoid longer qualified names. +Modules under the names `Plutus`, `Ledger` and `Plutus.V1.Ledger` SHOULD +be imported qualified with their module name, as per the general module standards. +An exception to this is `Plutus.V1.Ledger.Api`, where the `Ledger` name is preferred. +Some other exceptions to this are allowed where it may be more convenient to +avoid longer qualified names. For example: @@ -321,11 +333,11 @@ In some cases it may be justified to use a shortened module name: import Plutus.V1.Ledger.AddressMap qualified as AddrMap ``` -Modules under `PlutusTx` that are extensions to `PlutusTx.Prelude` MAY be imported unqualified when it is reasonable to do so. +Modules under `PlutusTx` that are extensions to `PlutusTx.Prelude` MAY be +imported unqualified when it is reasonable to do so. -The `Plutus.V1.Ledger.Api` module SHOULD be avoided in favour of more specific modules where possible. - -For example, we should avoid: +The `Plutus.V1.Ledger.Api` module SHOULD be avoided in favour of more +specific modules where possible. For example, we should avoid: ```haskell import Plutus.V1.Ledger.Api qualified as Ledger (ValidatorHash) @@ -339,10 +351,9 @@ import Plutus.V1.Ledger.Scripts qualified as Scripts (ValidatorHash) ### Justification -The Plutus API modules can be confusing, with numerous modules involved, many exporting the same items. - -Consistent qualified names help ease this problem, and decrease ambiguity about where imported items come from. - +The Plutus API modules can be confusing, with numerous modules involved, many +exporting the same items. Consistent qualified names help ease this problem, +and decrease ambiguity about where imported items come from. ## LANGUAGE pragmata @@ -610,7 +621,7 @@ anyway. The only reason to derive either of these is for compatibility with legacy libraries, which we don't have any of, and the number of which shrinks every year. If we're using this extension at all, it's probably a mistake. -``Foldable`` is possibly the most widely-used, lawless type class. Its only laws +``Foldable`` is possibly the most widely-used lawless type class. Its only laws are about self-consistency (such as agreement between ``foldMap`` and ``foldr``), but unlike something like ``Functor``, ``Foldable`` doesn't have any laws specifying its behaviour outside of 'it compiles'. As a result, even if we @@ -820,6 +831,8 @@ data Foo (a :: Type) = Bar | Baz [a] quux :: forall (m :: Type) . (Monoid m) => [m] -> m -> m ``` +`where`-bindings MUST have type signatures. + ### Justification Haskell lists are a large example of the legacy of the language: they (in the @@ -833,7 +846,8 @@ fusion optimizations), from the point of view of field values, they are a poor choice from both an efficiency perspective, both in theory _and_ in practice. For almost all cases where you would want a list field value, a ``Vector`` field value is more appropriate, and in almost all others, some other structure (such -as a ``Map``) is even better. +as a ``Map``) is even better. We make a named exception for on-chain code, as no +alternatives presently exist. Partial functions are runtime bombs waiting to explode. The number of times the 'impossible' happened, especially in production code, is significant in our @@ -897,6 +911,24 @@ as well as ensuring that we don't make any errors ourselves. This, together with explicit foralls, essentially bring the same practices to the kind level as the Haskell community already considers to be good at the type level. +`where` bindings are quite common in idiomatic Haskell, and quite often contain +non-trivial logic. They're also a common refactoring, and 'hole-driven +development' tool, where you create a hole to be filled with a `where`-bound +definition. Even in these cases, having an explicit signature on +`where`-bindings helps: during development, you can use typed holes inside the +`where`-binding with useful information (absent a signature, you'll get +nothing), and it makes the code much easier to understand, especially if the +`where`-binding is complex. It's also advantageous when 'promoting' +`where`-binds to full top-level definitions, as the signature is already there. +Since we need to do considerable type-level programming as part of Plutus, this +becomes even more important, as GHC's type inference algorithm can often fail in +those cases on `where`-bindings, which will sometimes fail to derive, giving a +very strange error message, which would need a signature to solve anyway. By +making this practice proactive, we are decreasing confusion, as well as +increasing readability. While in theory, this standard should extend to +`let`-bindings as well, these are much rarer, and can be given signatures with +`::` if `ScopedTypeVariables` is on (which it is for us by default) if needed. + # Design practices ## Parse, don't validate From 817d7bba7919846988237bf84f2f8c72ede51139 Mon Sep 17 00:00:00 2001 From: anthony stachowitz Date: Wed, 23 Jun 2021 13:46:09 -0400 Subject: [PATCH 68/81] install process work I have documented the install process up to the point that it works... there are some errors that need to be ironed out the we are having during the installation - There are some work arounds but I want to try to get it working the correct way. I implemented a new virtual machine and ran through the install process as I wrote this to make sure that everything up until running `make build` worked correctly. I just saw that @Benjmhart advised that we are keeping everything in this repo and I believe there is also a ticket in with IOHK to solve some of these issues. I will get with Ben and see how he wants me to proceed. --- mlabs/README.md | 73 ++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 66 insertions(+), 7 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index 2006fb56d..053c4be59 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -27,19 +27,78 @@ update as headings are expanded.* ## Overview MLabs has been working on developing two Plutus Use cases, specifically: -- [Use Case: Lendex](#use-case-lendex) -- [Use Case: NFT](#use-case-nft) + +- [Use Case: Lendex](#use-case-lendex) + +- [Use Case: NFT](#use-case-nft) ### Prerequisites -- List all dependencies, like `nix` etc. +- Git +- Curl +- Nix ### Building, Testing, Use -*Add step by step instructions on how to build, test and use the software.* - -1. Clone the repo and run `make` -2. ... +*It is recommended that all current updates to your system be done before installation* + +1) ***Install basic dependencies*** + + `sudo apt install curl` + + `sudo apt install git` + +2) ***Clone Directory*** + + Create a directory and clone the project: + + `git clone https://github.com/mlabs-haskell/plutus-use-cases.git` + +3) ***Install Nix*** + + + 1) **Setup Nix** + + $ `curl -L https://nixos.org/nix/install | sh` + + - *There is a issue with nix correctly adjusting the PATH in some machines. Please re-start your terminal and make sure Nix is in the path (`nix --version`). Please see this discussion if you are having this issue: https://github.com/NixOS/nix/issues/3317* + + - *This is the direct link to the nix download page for reference: https://nixos.org/download.html* + + 2) **Set up binary cache** + + ***Make sure to set up the IOHK binary cache. If you do not do this, you will end up building GHC, which takes several hours. If you find yourself building GHC, STOP and fix the cache.*** + + To set up the binary cache: + + * On **non-NixOS** machines: + Create a nix directory and file in the `etc` directory. + + 1) `sudo mkdir /etc/nix` + + 2) `sudo touch /etc/nix/nix.conf` + + *Then edit your `nix.conf` file to add:* + + `substituters = https://hydra.iohk.io https://iohk.cachix.org https://cache.nixos.org/` + `trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=` + + + * On **NixOS** Machines, add the following NixOs options: + + `nix = { + binaryCaches = [ "https://hydra.iohk.io" "https://iohk.cachix.org" ];` + `binaryCachePublicKeys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo=" ]; + };` + +Please see the original documentation at IOHK for reference: - [How to set up the IOHK binary caches](https://github.com/input-output-hk/plutus/blob/master/README.adoc#iohk-binary-cache) + +4) ***Create nix shell*** +Go to the `plutus-use-cases/mlabs` directory +run the `nix-shell` command: + + $ `nix-shell` + - *(This will take a little while the first time)* ### Documentation From 6f833c30968e49e1192194da770445e92e1fd8c4 Mon Sep 17 00:00:00 2001 From: Jozef Koval Date: Wed, 23 Jun 2021 23:12:30 +0200 Subject: [PATCH 69/81] Run HLS from nix-shell. --- mlabs/README.md | 2 ++ mlabs/hie.yaml | 2 ++ mlabs/shell.nix | 1 + 3 files changed, 5 insertions(+) create mode 100644 mlabs/README.md create mode 100644 mlabs/hie.yaml diff --git a/mlabs/README.md b/mlabs/README.md new file mode 100644 index 000000000..c5c1b402a --- /dev/null +++ b/mlabs/README.md @@ -0,0 +1,2 @@ +# HLS setup (tested for Visual Studio Code) +Start editor from nix-shell. Let the editor find the correct version of haskell-language-server binary. diff --git a/mlabs/hie.yaml b/mlabs/hie.yaml new file mode 100644 index 000000000..04cd24395 --- /dev/null +++ b/mlabs/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/mlabs/shell.nix b/mlabs/shell.nix index ac5d69593..0f2da45c1 100644 --- a/mlabs/shell.nix +++ b/mlabs/shell.nix @@ -33,6 +33,7 @@ with import ./nix { }; git ghc nixfmt + plutus.plutus.haskell-language-server # Pab pab.plutus_pab_client From 5a2b769eeb8fd72dd1b3565f15d5ad9ba5f7bd38 Mon Sep 17 00:00:00 2001 From: Vlad Date: Thu, 24 Jun 2021 12:18:46 +0100 Subject: [PATCH 70/81] update: added TODO: tag + small changes - easily track incomplete information by looking for the TODO: tag. --- mlabs/README.md | 52 ++++++++++++++++++++++++++++--------------------- 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index 053c4be59..92d075291 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -32,6 +32,8 @@ MLabs has been working on developing two Plutus Use cases, specifically: - [Use Case: NFT](#use-case-nft) +Please refer to each individual Plutus Use Case for more specific information. + ### Prerequisites - Git @@ -40,6 +42,8 @@ MLabs has been working on developing two Plutus Use cases, specifically: ### Building, Testing, Use +#### On Unix systems + *It is recommended that all current updates to your system be done before installation* 1) ***Install basic dependencies*** @@ -56,7 +60,6 @@ MLabs has been working on developing two Plutus Use cases, specifically: 3) ***Install Nix*** - 1) **Setup Nix** $ `curl -L https://nixos.org/nix/install | sh` @@ -91,7 +94,7 @@ MLabs has been working on developing two Plutus Use cases, specifically: `binaryCachePublicKeys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo=" ]; };` -Please see the original documentation at IOHK for reference: - [How to set up the IOHK binary caches](https://github.com/input-output-hk/plutus/blob/master/README.adoc#iohk-binary-cache) +Please see the original documentation at IOHK for reference: - [How to set up the IOHK binary caches](https://github.com/input-output-hk/plutus/blob/master/README.adoc#iohk-binary-cache) 4) ***Create nix shell*** Go to the `plutus-use-cases/mlabs` directory @@ -108,33 +111,36 @@ be found in the [MLabs gitHub repository](https://github.com/mlabs-haskell/plutu ### Testing For an overview of the tests refer to the [test folder](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs/test) +*TODO: Add the explanation of how to run tests* + -------------------------------------------------------------------------------- ## Use Case: Lendex ### Description -*Small description/summary* +*TODO: Small description/summary* ### Progress & Planning -- Goals and status: *add tasks and goals + their status* +- Goals and status: *TODO: add tasks and goals + their status* - Development - [x] *task 1(Done)* - [ ] *task 2(WIP)* - - Testing + - Testing *TODO: add tests + their status* - [ ] 50% Test Coverage - [ ] 100% Test Coverage - [ ] QuickCheck Testing - - Documentation - - [ ] Document Examples + - Documentation + - [ ] Examples + - [ ] APIs ### Examples - [Lendex Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/lendex-demo/Main.hs) -- *Add any other relevant examples* +- *TODO: Add any other relevant examples* ### APIs & Endpoints -- **API/Endpoint Name1** +- **API/Endpoint Name1** *TODO: add API & Endpoints + their status* - Description: *Add Description* - Develop/use: *Specify if using or developing the API/Endpoint* @@ -143,39 +149,41 @@ For an overview of the tests refer to the [test folder](https://github.com/mlabs - Develop/use: *Specify if using or developing the API/Endpoint* ### Notes -*Add any relevant notes* +*TODO: Add any relevant notes* -------------------------------------------------------------------------------- ## Use Case: NFT ### Description -*Small description/summary* +*TODO: Small description/summary* ### Progress & Planning - Goals and status: *add tasks and goals + their status* - - Development + - Development *TODO: add some achieved/ future goals* - [x] *task 1(Done)* - [ ] *task 2(WIP)* - - Testing + - Testing *TODO: add some achieved/ future tests* - [ ] 50% Test Coverage - [ ] 100% Test Coverage - [ ] QuickCheck Testing - - Documentation - - [ ] Document Examples + - Documentation + - [ ] Examples + - [ ] APIs ### Examples - [NFT Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/nft-demo/Main.hs) +- *TODO: Add any other relevant examples* -### APIs & Endpoints -- **API/Endpoint Name1** - - Description: *Add Description* - - Develop/use: *Specify if using or developing the API/Endpoint* +### APIs & Endpoints +- **API/Endpoint Name1** *TODO: add API & Endpoints* + - Description: *TODO: Add Description* + - Develop/use: *TODO: Specify if using or developing the API/Endpoint* - **API/Endpoint Name2** - - Description: *Add Description* - - Develop/use: *Specify if using or developing the API/Endpoint* + - Description: *TODO: Add Description* + - Develop/use: *TODO: Specify if using or developing the API/Endpoint* ### Notes -*Add any relevant notes* +*TODO: Add any relevant notes* From 75f029c2d0f29a4090bc698f90398de5e02366cf Mon Sep 17 00:00:00 2001 From: Vlad Date: Thu, 24 Jun 2021 12:29:25 +0100 Subject: [PATCH 71/81] update: add links to specifications --- mlabs/README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index 92d075291..9b662dfee 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -28,9 +28,9 @@ update as headings are expanded.* MLabs has been working on developing two Plutus Use cases, specifically: -- [Use Case: Lendex](#use-case-lendex) +- [Use Case: Lendex](#use-case-lendex) based on the specification of [Plutus Use case 3](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-3-lending-and-borrowing-collateral-escrow-flashloans). -- [Use Case: NFT](#use-case-nft) +- [Use Case: NFT](#use-case-nft) based on the specification of [Plutus Use case 5](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-5-nfts-minting-transfer-buying-and-selling-nfts). Please refer to each individual Plutus Use Case for more specific information. From 64ab8c04a118e0654439c144d6fe5376ad5e1795 Mon Sep 17 00:00:00 2001 From: Vlad Date: Thu, 24 Jun 2021 12:32:51 +0100 Subject: [PATCH 72/81] update: remove typo --- mlabs/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mlabs/README.md b/mlabs/README.md index 9b662dfee..17e381a59 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -21,7 +21,7 @@ * [APIs & Endpoints](#apis--endpoints-1) * [Notes](#notes-1) -*note: the table of contents is generated using `make readme_contents`. please +*note: the table of contents is generated using `make readme_contents`, please update as headings are expanded.* ## Overview From dfc82b5722b04191c0b48faa5705f9d5f5b936d6 Mon Sep 17 00:00:00 2001 From: cstml Date: Thu, 24 Jun 2021 23:01:22 +0100 Subject: [PATCH 73/81] update: added tests coverage --- mlabs/README.md | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index 17e381a59..3eec74fdf 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -125,13 +125,13 @@ For an overview of the tests refer to the [test folder](https://github.com/mlabs - [x] *task 1(Done)* - [ ] *task 2(WIP)* - - Testing *TODO: add tests + their status* - - [ ] 50% Test Coverage - - [ ] 100% Test Coverage + - Testing + - [x] 50% Test Coverage + - [x] 100% Test Coverage - [ ] QuickCheck Testing - Documentation - - [ ] Examples + - [x] Example - [ ] APIs ### Examples @@ -163,13 +163,13 @@ For an overview of the tests refer to the [test folder](https://github.com/mlabs - [x] *task 1(Done)* - [ ] *task 2(WIP)* - - Testing *TODO: add some achieved/ future tests* - - [ ] 50% Test Coverage - - [ ] 100% Test Coverage + - Testing + - [x] 50% Test Coverage + - [x] 100% Test Coverage - [ ] QuickCheck Testing - Documentation - - [ ] Examples + - [x] Example - [ ] APIs ### Examples From ee04101360705d4536225f7d62f1f774dfcb83ed Mon Sep 17 00:00:00 2001 From: cstml Date: Fri, 25 Jun 2021 12:27:14 +0100 Subject: [PATCH 74/81] update: added descriptions + reformatted a few bash entries. --- mlabs/README.md | 122 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 84 insertions(+), 38 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index 3eec74fdf..10be0f719 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -6,8 +6,10 @@ - [Overview](#overview) * [Prerequisites](#prerequisites) * [Building, Testing, Use](#building-testing-use) + + [On Unix systems](#on-unix-systems) * [Documentation](#documentation) * [Testing](#testing) + + [Running Tests](#running-tests) - [Use Case: Lendex](#use-case-lendex) * [Description](#description) * [Progress & Planning](#progress--planning) @@ -28,14 +30,15 @@ update as headings are expanded.* MLabs has been working on developing two Plutus Use cases, specifically: -- [Use Case: Lendex](#use-case-lendex) based on the specification of [Plutus Use case 3](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-3-lending-and-borrowing-collateral-escrow-flashloans). +- [Use Case: Lendex](#use-case-lendex) based on the specification of + [Plutus Use case 3](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-3-lending-and-borrowing-collateral-escrow-flashloans). -- [Use Case: NFT](#use-case-nft) based on the specification of [Plutus Use case 5](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-5-nfts-minting-transfer-buying-and-selling-nfts). +- [Use Case: NFT](#use-case-nft) based on the specification of + [Plutus Use case 5](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-5-nfts-minting-transfer-buying-and-selling-nfts). Please refer to each individual Plutus Use Case for more specific information. ### Prerequisites - - Git - Curl - Nix @@ -43,39 +46,48 @@ Please refer to each individual Plutus Use Case for more specific information. ### Building, Testing, Use #### On Unix systems - -*It is recommended that all current updates to your system be done before installation* +*It is recommended that all current updates to your system be done before +installation* 1) ***Install basic dependencies*** - `sudo apt install curl` - - `sudo apt install git` + ```bash + sudo apt install curl + sudo apt install git + ``` 2) ***Clone Directory*** Create a directory and clone the project: - - `git clone https://github.com/mlabs-haskell/plutus-use-cases.git` + + ```bash + git clone https://github.com/mlabs-haskell/plutus-use-cases.git + ``` 3) ***Install Nix*** 1) **Setup Nix** - - $ `curl -L https://nixos.org/nix/install | sh` - - *There is a issue with nix correctly adjusting the PATH in some machines. Please re-start your terminal and make sure Nix is in the path (`nix --version`). Please see this discussion if you are having this issue: https://github.com/NixOS/nix/issues/3317* + ```bash + $ curl -L https://nixos.org/nix/install | sh + ``` + - *There is a issue with nix correctly adjusting the PATH in some machines. + Please re-start your terminal and make sure Nix is in the path (`nix --version`). + See this discussion if you are having this issue: [https://github.com/NixOS/nix/issues/3317](https://github.com/NixOS/nix/issues/3317).* - - *This is the direct link to the nix download page for reference: https://nixos.org/download.html* + - *The direct link to the nix download page for reference: [https://nixos.org/download.html](https://nixos.org/download.html).* 2) **Set up binary cache** + + **note: Make sure to set up the IOHK binary cache. If you do not do this, you + will end up building GHC, which takes several hours. If you find + yourself building GHC, STOP and fix the cache.** - ***Make sure to set up the IOHK binary cache. If you do not do this, you will end up building GHC, which takes several hours. If you find yourself building GHC, STOP and fix the cache.*** - - To set up the binary cache: + - To set up the binary cache: - * On **non-NixOS** machines: - Create a nix directory and file in the `etc` directory. + * On **non-NixOS** machines: + + Create a nix directory and file in the `etc` directory. 1) `sudo mkdir /etc/nix` @@ -94,36 +106,60 @@ Please refer to each individual Plutus Use Case for more specific information. `binaryCachePublicKeys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo=" ]; };` -Please see the original documentation at IOHK for reference: - [How to set up the IOHK binary caches](https://github.com/input-output-hk/plutus/blob/master/README.adoc#iohk-binary-cache) +Please see the original documentation at IOHK for reference: +- [How to set up the IOHK binary caches](https://github.com/input-output-hk/plutus/blob/master/README.adoc#iohk-binary-cache) 4) ***Create nix shell*** -Go to the `plutus-use-cases/mlabs` directory -run the `nix-shell` command: - $ `nix-shell` - - *(This will take a little while the first time)* +Go to the `plutus-use-cases/mlabs` directory run the `nix-shell` command: +```bash + $ nix-shell +``` +- *note: This will take some time on the first run, as the dependencies get built locally.* ### Documentation - Currently the documentation is done via this document which can be found in the [MLabs gitHub repository](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs) ### Testing -For an overview of the tests refer to the [test folder](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs/test) +For an overview of the test coverage and implementation refer to the individual +cases documentation and the [test folder](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs/test). +#### Running Tests *TODO: Add the explanation of how to run tests* -------------------------------------------------------------------------------- ## Use Case: Lendex ### Description -*TODO: Small description/summary* +The Lendex Use Case is based on the Open Source, Non-Custodial Aave Protocol, +described in the [Aave Protocol +Whitepaper](https://github.com/aave/aave-protocol/blob/master/docs/Aave_Protocol_Whitepaper_v1_0.pdf). +The use case can be summaraised as a platform for a decentralised, pool-based, +loan strategy. + +As described in the whitepaper, the model relies on Lenders depositing (Cardano) +cryptocurrency in a Pool Contract. The same Pool Contract provides a source for +funds to be borrowed by Borrowes through the placement of a collateral. Loans do +not need to be individually matched, but rather rely on the pooled funds, the +amounts borrowed and their respective collateral. The model enables instant +loans and the interest rate for both borrowers and lenders is decided +algorithimically. A general description of the interest algorithm is: + + - Borrower's interest is tied to the amount of funds available in the pool at + a specific time - with scarcity of funds driving the interest rate up. + + - Lender's interest rate corresponds to the earn rate, with the algorithm + safeguarding a liquidity reserve to guarantee ease of withdrawals at any + given time. ### Progress & Planning -- Goals and status: *TODO: add tasks and goals + their status* +- Goals and status: - Development - - [x] *task 1(Done)* - - [ ] *task 2(WIP)* + - [x] Feature Completeness as per Specifications + - [ ] Improve Deployment Story + - [ ] Improve Performance + - [ ] Improve Ergonomics of Use and Installation - Testing - [x] 50% Test Coverage @@ -136,10 +172,8 @@ For an overview of the tests refer to the [test folder](https://github.com/mlabs ### Examples - [Lendex Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/lendex-demo/Main.hs) -- *TODO: Add any other relevant examples* ### APIs & Endpoints - - **API/Endpoint Name1** *TODO: add API & Endpoints + their status* - Description: *Add Description* - Develop/use: *Specify if using or developing the API/Endpoint* @@ -155,16 +189,29 @@ For an overview of the tests refer to the [test folder](https://github.com/mlabs ## Use Case: NFT ### Description -*TODO: Small description/summary* +The core functionality of the Non Fungible Tokens(i.e. NFTs) Use Case revolves +around minting, sending, receiving NFTs into a Cardano wallet. + +NFTs are a digital asset that represents real-world objects. They can be bought +and sold online, and act as a proof of ownership for the underlying asset they +are meant to represent. Fungibility is the property of an asset to be +interchangeable with its equal value in another fungible asset (example: $1 and +10x $0.10 are interchangeable). Given that real-world objects cannot be replaced +as easily with equivalent objects is a propert reflected in the nature of NFTs. + +For more details on NFT's refer to: + - [Forbes: What You Need To Know About NFT's](https://www.forbes.com/advisor/investing/nft-non-fungible-token/) + - [Cambridge Dictionary: nonfungible](https://dictionary.cambridge.org/us/dictionary/english/nonfungible) ### Progress & Planning -- Goals and status: *add tasks and goals + their status* +- Goals and status: - Development *TODO: add some achieved/ future goals* - - [x] *task 1(Done)* - - [ ] *task 2(WIP)* + - [x] Feature Completeness as per Specifications + - [ ] Improve Deployment Story + - [ ] Improve Performance + - [ ] Improve Ergonomics of Use and Installation - Testing - - [x] 50% Test Coverage - [x] 100% Test Coverage - [ ] QuickCheck Testing @@ -174,7 +221,6 @@ For an overview of the tests refer to the [test folder](https://github.com/mlabs ### Examples - [NFT Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/nft-demo/Main.hs) -- *TODO: Add any other relevant examples* ### APIs & Endpoints - **API/Endpoint Name1** *TODO: add API & Endpoints* From 83918d17daeec1517af62162356b17640743ed3e Mon Sep 17 00:00:00 2001 From: cstml Date: Fri, 25 Jun 2021 12:36:04 +0100 Subject: [PATCH 75/81] update: added lendex-demo repl command --- mlabs/README.md | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/mlabs/README.md b/mlabs/README.md index 10be0f719..938cdd386 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -172,7 +172,11 @@ algorithimically. A general description of the interest algorithm is: ### Examples - [Lendex Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/lendex-demo/Main.hs) - + - to run the `lendex-demo` run the following command from the root folder + ```bash + cd mlabs \ + && nix-shell --command "cabal v2-repl lendex-demo" + ``` ### APIs & Endpoints - **API/Endpoint Name1** *TODO: add API & Endpoints + their status* - Description: *Add Description* From 7fb27c9d11e43d8a4f77157face05d0667b7993c Mon Sep 17 00:00:00 2001 From: cstml Date: Fri, 25 Jun 2021 17:54:18 +0100 Subject: [PATCH 76/81] update: wrote down the APIs, descriptions left to do --- mlabs/README.md | 66 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 50 insertions(+), 16 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index 938cdd386..c303ea5d0 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -177,17 +177,49 @@ algorithimically. A general description of the interest algorithm is: cd mlabs \ && nix-shell --command "cabal v2-repl lendex-demo" ``` -### APIs & Endpoints -- **API/Endpoint Name1** *TODO: add API & Endpoints + their status* - - Description: *Add Description* - - Develop/use: *Specify if using or developing the API/Endpoint* - -- **API/Endpoint Name2** - - Description: *Add Description* - - Develop/use: *Specify if using or developing the API/Endpoint* +Are defined in [mlabs/src/Mlabs/Lending/Contract/Api.hs](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/src/Mlabs/Lending/Contract/Api.hs#L146) +- User Actions *TODO: write descriptions* + - Borrow + - [x] in use + - Repay + - [x] in use + - SwapBorrowRateModel + - [x] in use + - SetUserReserveAsCollateral + - [x] in use + - Withdraw + - [x] in use + - LiquidationCall + - [x] in use + - InterestRateFlag + - [x] in use + - toInterestRateFlag + - [x] in use + - fromInterestRateFlag + - [x] in use + +- Admin actions + - AddReserve + - [x] in use + - StartParams + - [x] in use + +- Price oracle actions + - SetAssetPrice + - [x] in use + +- Action conversions + - IsUserAct + - [x] in use + - IsPriceAct + - [x] in use + - IsGovernAct + - [x] in use + +### Tests +- *TODO: cover some test examples* ### Notes -*TODO: Add any relevant notes* -------------------------------------------------------------------------------- ## Use Case: NFT @@ -227,13 +259,15 @@ For more details on NFT's refer to: - [NFT Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/nft-demo/Main.hs) ### APIs & Endpoints -- **API/Endpoint Name1** *TODO: add API & Endpoints* - - Description: *TODO: Add Description* - - Develop/use: *TODO: Specify if using or developing the API/Endpoint* - -- **API/Endpoint Name2** - - Description: *TODO: Add Description* - - Develop/use: *TODO: Specify if using or developing the API/Endpoint* +- User Endpoints *TODO: write descriptions* + - Buy + - SetPrice + +- Author Endpoints + - StartParams + +### Tests +- *TODO: cover some test examples* ### Notes *TODO: Add any relevant notes* From 73692013e0584f2f164d3a95241282d3ad6db456 Mon Sep 17 00:00:00 2001 From: cstml Date: Mon, 28 Jun 2021 15:15:22 +0100 Subject: [PATCH 77/81] update: API description added --- mlabs/README.md | 258 +++++++++++++++++++++++++++++------------------- 1 file changed, 156 insertions(+), 102 deletions(-) diff --git a/mlabs/README.md b/mlabs/README.md index c303ea5d0..817b2a911 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -1,76 +1,85 @@ # MLabs: Plutus Use Cases + -------------------------------------------------------------------------------- + ## Contents -- [Contents](#contents) -- [Overview](#overview) - * [Prerequisites](#prerequisites) - * [Building, Testing, Use](#building-testing-use) - + [On Unix systems](#on-unix-systems) - * [Documentation](#documentation) - * [Testing](#testing) - + [Running Tests](#running-tests) -- [Use Case: Lendex](#use-case-lendex) - * [Description](#description) - * [Progress & Planning](#progress--planning) - * [Examples](#examples) - * [APIs & Endpoints](#apis--endpoints) - * [Notes](#notes) -- [Use Case: NFT](#use-case-nft) - * [Description](#description-1) - * [Progress & Planning](#progress--planning-1) - * [Examples](#examples-1) - * [APIs & Endpoints](#apis--endpoints-1) - * [Notes](#notes-1) +- [MLabs: Plutus Use Cases](#mlabs-plutus-use-cases) + - [Contents](#contents) + - [Overview](#overview) + - [Prerequisites](#prerequisites) + - [Building, Testing, Use](#building-testing-use) + - [On Unix Systems](#on-unix-systems) + - [Documentation](#documentation) + - [Testing](#testing) + - [Running Tests](#running-tests) + - [Use Case: Lendex](#use-case-lendex) + - [Lendex: Description](#lendex-description) + - [Lendex: Progress & Planning](#lendex-progress--planning) + - [Lendex: Examples](#lendex-examples) + - [Lendex: APIs & Endpoints](#lendex-apis--endpoints) + - [Lendex: Tests](#lendex-tests) + - [Lendex: Notes](#lendex-notes) + - [Use Case: NFT](#use-case-nft) + - [NFT: Description](#nft-description) + - [NFT: Progress & Planning](#nft-progress--planning) + - [NFT: Examples](#nft-examples) + - [NFT: APIs & Endpoints](#nft-apis--endpoints) + - [NFT: Tests](#nft-tests) + - [NFT: Notes](#nft-notes) *note: the table of contents is generated using `make readme_contents`, please update as headings are expanded.* +-------------------------------------------------------------------------------- + ## Overview MLabs has been working on developing two Plutus Use cases, specifically: -- [Use Case: Lendex](#use-case-lendex) based on the specification of - [Plutus Use case 3](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-3-lending-and-borrowing-collateral-escrow-flashloans). +- [Use Case: Lendex](#use-case-lendex) based on the specification of + [Plutus Use case 3](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-3-lending-and-borrowing-collateral-escrow-flashloans). -- [Use Case: NFT](#use-case-nft) based on the specification of - [Plutus Use case 5](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-5-nfts-minting-transfer-buying-and-selling-nfts). +- [Use Case: NFT](#use-case-nft) based on the specification of + [Plutus Use case 5](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-5-nfts-minting-transfer-buying-and-selling-nfts). Please refer to each individual Plutus Use Case for more specific information. ### Prerequisites -- Git + +- Git - Curl - Nix ### Building, Testing, Use -#### On Unix systems +#### On Unix Systems + *It is recommended that all current updates to your system be done before installation* -1) ***Install basic dependencies*** +1) ***Install basic dependencies*** - ```bash - sudo apt install curl - sudo apt install git - ``` +```bash +sudo apt install curl +sudo apt install git +``` 2) ***Clone Directory*** - Create a directory and clone the project: +Create a directory and clone the project: + +```bash +git clone https://github.com/mlabs-haskell/plutus-use-cases.git +``` - ```bash - git clone https://github.com/mlabs-haskell/plutus-use-cases.git - ``` - 3) ***Install Nix*** - 1) **Setup Nix** + 1) **Setup Nix** - ```bash - $ curl -L https://nixos.org/nix/install | sh - ``` + ```bash + $ curl -L https://nixos.org/nix/install | sh + ``` - *There is a issue with nix correctly adjusting the PATH in some machines. Please re-start your terminal and make sure Nix is in the path (`nix --version`). See this discussion if you are having this issue: [https://github.com/NixOS/nix/issues/3317](https://github.com/NixOS/nix/issues/3317).* @@ -129,31 +138,33 @@ cases documentation and the [test folder](https://github.com/mlabs-haskell/plutu *TODO: Add the explanation of how to run tests* -------------------------------------------------------------------------------- -## Use Case: Lendex -### Description +## Use Case: Lendex + +### Lendex: Description + The Lendex Use Case is based on the Open Source, Non-Custodial Aave Protocol, described in the [Aave Protocol Whitepaper](https://github.com/aave/aave-protocol/blob/master/docs/Aave_Protocol_Whitepaper_v1_0.pdf). -The use case can be summaraised as a platform for a decentralised, pool-based, +The use case can be summarised as a platform for a decentralised, pool-based, loan strategy. As described in the whitepaper, the model relies on Lenders depositing (Cardano) cryptocurrency in a Pool Contract. The same Pool Contract provides a source for -funds to be borrowed by Borrowes through the placement of a collateral. Loans do +funds to be borrowed by Borrowers through the placement of a collateral. Loans do not need to be individually matched, but rather rely on the pooled funds, the amounts borrowed and their respective collateral. The model enables instant loans and the interest rate for both borrowers and lenders is decided -algorithimically. A general description of the interest algorithm is: +algorithmically. A general description of the interest algorithm is: + +- Borrower's interest is tied to the amount of funds available in the pool at + a specific time - with scarcity of funds driving the interest rate up. +- Lender's interest rate corresponds to the earn rate, with the algorithm + safeguarding a liquidity reserve to guarantee ease of withdrawals at any + given time. - - Borrower's interest is tied to the amount of funds available in the pool at - a specific time - with scarcity of funds driving the interest rate up. - - - Lender's interest rate corresponds to the earn rate, with the algorithm - safeguarding a liquidity reserve to guarantee ease of withdrawals at any - given time. +### Lendex: Progress & Planning -### Progress & Planning - Goals and status: - Development - [x] Feature Completeness as per Specifications @@ -161,70 +172,87 @@ algorithimically. A general description of the interest algorithm is: - [ ] Improve Performance - [ ] Improve Ergonomics of Use and Installation - - Testing + - Testing - [x] 50% Test Coverage - [x] 100% Test Coverage - [ ] QuickCheck Testing - - Documentation + - Documentation - [x] Example - [ ] APIs -### Examples +### Lendex: Examples + - [Lendex Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/lendex-demo/Main.hs) - - to run the `lendex-demo` run the following command from the root folder + - to run the `lendex-demo` run the following command from the root folder: + ```bash cd mlabs \ && nix-shell --command "cabal v2-repl lendex-demo" ``` + Are defined in [mlabs/src/Mlabs/Lending/Contract/Api.hs](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/src/Mlabs/Lending/Contract/Api.hs#L146) -- User Actions *TODO: write descriptions* + +### Lendex: APIs & Endpoints + +- User Actions + + - Deposit + - [x] in use. + - Description: *Deposit funds to app.* + - Borrow - - [x] in use + - [x] in use. + - Description: *Borrow funds by depositing a collateral.* + - Repay - - [x] in use + - [x] in use. + - Description: *Repay part of a Loan.* + - SwapBorrowRateModel - - [x] in use + - [x] in use. + - Description: *Swap borrow interest rate strategy (stable to variable).* + - SetUserReserveAsCollateral - - [x] in use + - [x] in use. + - Description: *Set some portion of deposit as collateral or some portion of collateral as deposit.* + - Withdraw - - [x] in use + - [x] in use. + - Description: *Withdraw funds from deposit.* + - LiquidationCall - - [x] in use - - InterestRateFlag - - [x] in use - - toInterestRateFlag - - [x] in use - - fromInterestRateFlag - - [x] in use + - [x] in use. + - Description: *Call to liquidate borrows that are unsafe due to health check. For further see [docs.aave.com/faq/liquidations](https://docs.aave.com/faq/liquidations)* - Admin actions + - AddReserve - - [x] in use - - StartParams - - [x] in use - -- Price oracle actions - - SetAssetPrice - - [x] in use - -- Action conversions - - IsUserAct - - [x] in use - - IsPriceAct - - [x] in use - - IsGovernAct - - [x] in use + - [x] in use. + - Description: *Adds a new reserve.* -### Tests -- *TODO: cover some test examples* + - StartParams + - [x] in use. + - Description: *Sets the start parameters for the Lendex*. -### Notes +### Lendex: Tests + +- To run the tests: + +```bash +stack test all +``` + +- To see test cases refer to: `./test/Test/Lending` + +### Lendex: Notes -------------------------------------------------------------------------------- + ## Use Case: NFT -### Description +### NFT: Description + The core functionality of the Non Fungible Tokens(i.e. NFTs) Use Case revolves around minting, sending, receiving NFTs into a Cardano wallet. @@ -236,38 +264,64 @@ interchangeable with its equal value in another fungible asset (example: $1 and as easily with equivalent objects is a propert reflected in the nature of NFTs. For more details on NFT's refer to: - - [Forbes: What You Need To Know About NFT's](https://www.forbes.com/advisor/investing/nft-non-fungible-token/) - - [Cambridge Dictionary: nonfungible](https://dictionary.cambridge.org/us/dictionary/english/nonfungible) -### Progress & Planning -- Goals and status: +- [Forbes: What You Need To Know About NFT's](https://www.forbes.com/advisor/investing/nft-non-fungible-token/) +- [Cambridge Dictionary: nonfungible](https://dictionary.cambridge.org/us/dictionary/english/nonfungible) + +### NFT: Progress & Planning + +- Goals and status: - Development *TODO: add some achieved/ future goals* - [x] Feature Completeness as per Specifications - [ ] Improve Deployment Story - [ ] Improve Performance - [ ] Improve Ergonomics of Use and Installation - - Testing + - Testing - [x] 100% Test Coverage - [ ] QuickCheck Testing - - Documentation + - Documentation - [x] Example - [ ] APIs -### Examples +### NFT: Examples + - [NFT Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/nft-demo/Main.hs) -### APIs & Endpoints -- User Endpoints *TODO: write descriptions* +### NFT: APIs & Endpoints + +- User Endpoints: - Buy + - [x] in use. + - Description: *User buys NFT.* - SetPrice + - [x] in use. + - Description: *User sets new price for NFT.* -- Author Endpoints +- Author Endpoints: - StartParams - -### Tests -- *TODO: cover some test examples* + - [x] in use. + - Description: *Sets the parameters to initialise a new NFT.* + +- User Schemas: + - UserSchema + - [x] in use. + - Description: *User schema. Owner can set the price and the buyer can try to buy.* + - AuthorSchema + - [x] in use. + - Description: *Schema for the author of NFT*. + +### NFT: Tests + +- To run the tests: + +```bash +stack test all +``` + +- To see test cases refer to: `./test/Test/Nft` + +### NFT: Notes -### Notes *TODO: Add any relevant notes* From 9e89fe3975c21c54bca6bb58648d6d2e5dc8960f Mon Sep 17 00:00:00 2001 From: cstml Date: Mon, 28 Jun 2021 15:37:11 +0100 Subject: [PATCH 78/81] update: clean-up --- mlabs/README.md | 1 - 1 file changed, 1 deletion(-) diff --git a/mlabs/README.md b/mlabs/README.md index 817b2a911..26b5afd16 100644 --- a/mlabs/README.md +++ b/mlabs/README.md @@ -173,7 +173,6 @@ algorithmically. A general description of the interest algorithm is: - [ ] Improve Ergonomics of Use and Installation - Testing - - [x] 50% Test Coverage - [x] 100% Test Coverage - [ ] QuickCheck Testing From 9c0e56f664f7f11057d4b9234bdc75b68076ab29 Mon Sep 17 00:00:00 2001 From: Oleg Prutz Date: Tue, 29 Jun 2021 23:59:57 +0300 Subject: [PATCH 79/81] Add a simple deposit property-based test Generalize `Logic` deposit script test for `Lending` demo over deposit amounts --- mlabs/mlabs-plutus-use-cases.cabal | 3 + mlabs/test/Main.hs | 4 +- mlabs/test/Test/Lending/Init.hs | 1 + mlabs/test/Test/Lending/Logic.hs | 4 + mlabs/test/Test/Lending/QuickCheck.hs | 129 ++++++++++++++++++++++++++ 5 files changed, 140 insertions(+), 1 deletion(-) create mode 100644 mlabs/test/Test/Lending/QuickCheck.hs diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index ae770ac3e..d49a68a2b 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -266,6 +266,8 @@ Test-suite mlabs-plutus-use-cases-tests , tasty , tasty-hunit , tasty-expected-failure + , tasty-quickcheck + , QuickCheck , text hs-source-dirs: test Main-is: Main.hs @@ -273,6 +275,7 @@ Test-suite mlabs-plutus-use-cases-tests Test.Lending.Contract Test.Lending.Init Test.Lending.Logic + Test.Lending.QuickCheck Test.Nft.Contract Test.Nft.Init Test.Nft.Logic diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index cbf0ae64c..0ea5120de 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -5,6 +5,7 @@ import Test.Tasty.ExpectedFailure (ignoreTest) import qualified Test.Lending.Contract as Lending.Contract import qualified Test.Lending.Logic as Lending.Logic +import qualified Test.Lending.QuickCheck as Lending.QuickCheck import qualified Test.Nft.Logic as Nft.Logic import qualified Test.Nft.Contract as Nft.Contract @@ -13,7 +14,8 @@ main = defaultMain $ testGroup "tests" [ testGroup "NFT" [ Nft.Logic.test , contract Nft.Contract.test ] , testGroup "Lending" [ Lending.Logic.test - , contract Lending.Contract.test ] + , contract Lending.Contract.test + , Lending.QuickCheck.test ] ] where contract diff --git a/mlabs/test/Test/Lending/Init.hs b/mlabs/test/Test/Lending/Init.hs index 55db8732f..2d3acc708 100644 --- a/mlabs/test/Test/Lending/Init.hs +++ b/mlabs/test/Test/Lending/Init.hs @@ -10,6 +10,7 @@ module Test.Lending.Init( , toUserId , toPubKeyHash , lendexId + , fromToken ) where import Prelude diff --git a/mlabs/test/Test/Lending/Logic.hs b/mlabs/test/Test/Lending/Logic.hs index dc3187471..a903bb32d 100644 --- a/mlabs/test/Test/Lending/Logic.hs +++ b/mlabs/test/Test/Lending/Logic.hs @@ -2,6 +2,10 @@ module Test.Lending.Logic( test , testScript + , fromToken + , testAppConfig + , user1, user2, user3 + , coin1, coin2, coin3 ) where import Test.Tasty diff --git a/mlabs/test/Test/Lending/QuickCheck.hs b/mlabs/test/Test/Lending/QuickCheck.hs new file mode 100644 index 000000000..c29a952d8 --- /dev/null +++ b/mlabs/test/Test/Lending/QuickCheck.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE NumericUnderscores #-} + +module Test.Lending.QuickCheck where + +import Mlabs.Emulator.Types (UserId(..), Coin, adaCoin) +import Mlabs.Lending.Logic.Types (UserAct(..)) +import Mlabs.Lending.Logic.App (AppConfig(..), Script, runLendingApp, userAct) +import Mlabs.Emulator.Blockchain (BchWallet(..)) +import Mlabs.Emulator.App (App(..), lookupAppWallet) +import Test.Lending.Logic (fromToken, testAppConfig, coin1, coin2, coin3, user1, user2, user3) +import qualified Plutus.V1.Ledger.Value as Value +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) +import qualified Test.QuickCheck as QC + + +allUsers :: [UserId] +allUsers = [Self, user1, user2, user3] + +users :: [UserId] +users = drop 1 allUsers + +coins :: [Coin] +coins = [adaCoin, coin1, coin2, coin3] + +nonNativeCoins :: [Coin] +nonNativeCoins = drop 1 coins + +aToken :: Coin -> Value.TokenName +aToken (Value.AssetClass (_, Value.TokenName tn)) = Value.TokenName ("a" <> tn) + +aCoin :: Coin -> Coin +aCoin coin = fromToken (aToken coin) + +-- Various integer generators +smallGenSize :: Int +smallGenSize = 100 + +bigGenSize :: Int +bigGenSize = 1_000_000_000_000_000_000 + +positiveSmallInteger :: QC.Gen Integer +positiveSmallInteger = fmap QC.getPositive (QC.resize smallGenSize QC.arbitrary) + +positiveBigInteger :: QC.Gen Integer +positiveBigInteger = (*) <$> gen <*> gen + where gen = fmap QC.getPositive (QC.resize bigGenSize QC.arbitrary) + +nonPositiveSmallInteger :: QC.Gen Integer +nonPositiveSmallInteger = fmap (negate . abs) (QC.resize smallGenSize QC.arbitrary) + +nonPositiveBigInteger :: QC.Gen Integer +nonPositiveBigInteger = (\x y -> negate (abs (x * y))) <$> gen <*> gen + where gen = fmap negate (QC.resize bigGenSize QC.arbitrary) + +positiveInteger :: QC.Gen Integer +positiveInteger = QC.frequency [(1, positiveSmallInteger), (1, positiveBigInteger)] + +nonPositiveInteger :: QC.Gen Integer +nonPositiveInteger = QC.frequency [(1, nonPositiveSmallInteger), (1, nonPositiveBigInteger)] + +-- | Contains parameters that deposit test cases can be generalized over +data DepositTestInput = DepositTestInput + { deposits :: [(UserId, Coin, Integer)] } + deriving Show + +-- | Construct a `Script` +createDepositScript :: DepositTestInput -> Script +createDepositScript (DepositTestInput ds) = + mapM_ (\(user, coin, amt) -> userAct user $ DepositAct amt coin) ds + +noErrorsProp :: App st act -> Bool +noErrorsProp app = null (app'log app) + +someErrorsProp :: App st act -> Bool +someErrorsProp app = not (null (app'log app)) + +hasWallet :: App st act -> UserId -> BchWallet -> Bool +hasWallet app uid wal = lookupAppWallet uid app == Just wal + +checkWalletsProp :: (Show act, Show st) => [(UserId, BchWallet)] -> App st act -> Bool +checkWalletsProp wals app = all (uncurry $ hasWallet app) wals + +-- Map maniplation helper functions +walletListToNestedMap :: [(UserId, BchWallet)] -> Map UserId (Map Coin Integer) +walletListToNestedMap wals = + addNestedMaps $ map (\(user, BchWallet wal) -> Map.singleton user wal) wals + +nestedMapToWalletList :: Map UserId (Map Coin Integer) -> [(UserId, BchWallet)] +nestedMapToWalletList m = Map.toAscList (Map.map BchWallet m) + +addNestedMaps :: [Map UserId (Map Coin Integer)] -> Map UserId (Map Coin Integer) +addNestedMaps = Map.unionsWith (Map.unionWith (+)) + +-- | Calculate expected balances after running deposit script +expectedWalletsDeposit :: AppConfig -> DepositTestInput -> [(UserId, BchWallet)] +expectedWalletsDeposit appCfg (DepositTestInput ds) = + let startingBalances = walletListToNestedMap (appConfig'users appCfg) + depositedCoins = map (\(user, coin, amt) -> Map.singleton user (Map.singleton coin (negate amt))) ds + aCoins = map (\(user, coin, amt) -> Map.singleton user (Map.singleton (aCoin coin) amt)) ds + appCoins = Map.singleton Self $ Map.unionsWith (+) (map (\(_, coin, amt) -> Map.singleton coin amt) ds) + appAcoins = Map.singleton Self $ Map.fromList $ map (\(_, coin, _) -> (aCoin (coin), 0)) ds + allWallets = addNestedMaps ([startingBalances] ++ depositedCoins ++ aCoins ++ [appCoins] ++ [appAcoins]) + in Map.toAscList (Map.map BchWallet allWallets) + +-- | Check that the balances after deposit script run correspond to the expected balances +testWalletsProp :: [(UserId, BchWallet)] -> Script -> Bool +testWalletsProp expectedWals script = + let app = runLendingApp testAppConfig script + in noErrorsProp app && checkWalletsProp expectedWals app + +testWalletsProp' :: DepositTestInput -> Bool +testWalletsProp' d = + let script = createDepositScript d + in testWalletsProp (expectedWalletsDeposit testAppConfig d) script + +depositInputGen :: QC.Gen Integer -> QC.Gen DepositTestInput +depositInputGen integerGen = + fmap (DepositTestInput . zip3 users nonNativeCoins) (QC.vectorOf n integerGen) + where n = length users + +testDepositLogic :: QC.Property +testDepositLogic = QC.forAll (depositInputGen (QC.choose (1, 100))) (testWalletsProp') + +test :: TestTree +test = testGroup "QuickCheck" [testGroup "Logic" [testProperty "deposit" testDepositLogic]] From e756ee2a2802af1b45dda0a8cdc8cfde484758ba Mon Sep 17 00:00:00 2001 From: Ben Hart Date: Wed, 30 Jun 2021 10:55:02 -0400 Subject: [PATCH 80/81] resolving conflicts --- STANDARDS.md | 1027 +++ mlabs/.gitignore | 5 + mlabs/Makefile | 8 +- mlabs/README.md | 329 + mlabs/demo-frontend/package-lock.json | 9494 +++++++++++++++++++++++++ mlabs/hie.yaml | 2 + mlabs/mlabs-plutus-use-cases.cabal | 3 + mlabs/shell.nix | 1 + mlabs/src/Mlabs/Demo/Contract/Burn.hs | 57 + mlabs/src/Mlabs/Demo/Contract/Mint.hs | 134 + mlabs/test/Main.hs | 2 + mlabs/test/Test/Demo/Contract/Mint.hs | 86 + 12 files changed, 11146 insertions(+), 2 deletions(-) create mode 100644 STANDARDS.md create mode 100644 mlabs/README.md create mode 100644 mlabs/demo-frontend/package-lock.json create mode 100644 mlabs/hie.yaml create mode 100644 mlabs/src/Mlabs/Demo/Contract/Burn.hs create mode 100644 mlabs/src/Mlabs/Demo/Contract/Mint.hs create mode 100644 mlabs/test/Test/Demo/Contract/Mint.hs diff --git a/STANDARDS.md b/STANDARDS.md new file mode 100644 index 000000000..4f33b859f --- /dev/null +++ b/STANDARDS.md @@ -0,0 +1,1027 @@ +# Introduction + +This document describes a set of standards for all code under the Plutus Use Cases +project. It also explains our reasoning for these choices, and acts as a living +document of our practices for current and future contributors to the project. We +intend for this document to evolve as our needs change, as well as act as a +single point of truth for standards. + +# Motivation + +The desired outcomes from the prescriptions in this document are as follows. + +## Increase consistency + +Inconsistency is worse than _any_ standard, as it requires us to track a large +amount of case-specific information. Software development is already a difficult +task due to the inherent complexities of the problems we seek to solve, as well +as the inherent complexities foisted upon us by _decades_ of bad historical +choices we have no control over. For newcomers to a project and old hands alike, +increased inconsistency translates to developmental friction, resulting in +wasted time, frustration and ultimately, worse outcomes for the code in +question. + +To avoid putting ourselves into this boat, both currently and in the future, we +must strive to be _automatically consistent_. Similar things should look +similar; different things should look different; as much as possible, we must +pick some rules _and stick to them_; and this has to be clear, explicit and +well-motivated. This will ultimately benefit us, in both the short and the long +term. The standards described here, as well as this document itself, is written +with this foremost in mind. + +## Limit non-local information + +There is a limited amount of space in a developer's skull; we all have bad days, +and we forget things or make decisions that, perhaps, may not be ideal at the +time. Therefore, limiting cognitive load is good for us, as it reduces the +amount of trouble we can inflict due to said skull limitations. One of the worst +contributors to cognitive load (after inconsistency) is _non-local information_ +- the requirement to have some understanding beyond the scope of the current +unit of work. That unit of work can be a data type, a module, or even a whole +project; in all cases, the more non-local information we require ourselves to +hold in our minds, the less space that leaves for actually doing the task at +hand, and the more errors we will introduce as a consequence. + +Thus, we must limit the need for non-local information at all possible levels. +'Magic' of any sort must be avoided; as much locality as possible must be +present everywhere; needless duplication of effort or result must be avoided. +Thus, our work must be broken down into discrete, minimal, logical units, which +can be analyzed, worked on, reviewed and tested in as much isolation as +possible. This also applies to our external dependencies. + +Thus, many of the decisions described here are oriented around limiting the +amount of non-local knowledge required at all levels of the codebase. +Additionally, we aim to avoid doing things 'just because we can' in a way that +would be difficult for other Haskellers to follow, regardless of skill level. + +## Minimize impact of legacy + +Haskell is a language that is older than some of the people currently writing +it; parts of its ecosystem are not exempt from it. With age comes legacy, and +much of it is based on historical decisions which we now know to be problematic +or wrong. We can't avoid our history, but we can minimize its impact on our +current work. + +Thus, we aim to codify good practices in this document _as seen today_. We also +try to avoid obvious 'sharp edges' by proscribing them away in a principled, +consistent and justifiable manner. + +## Automate away drudgery + +As developers, we should use our tools to make ourselves as productive as +possible. There is no reason for us to do a task if a machine could do it for +us, especially when this task is something boring or repetitive. We love Haskell +as a language not least of all for its capability to abstract, to describe, and +to make fun what other languages make dull or impossible; likewise, our work +must do the same. + +Many of the tool-related proscriptions and requirements in this document are +driven by a desire to remove boring, repetitive tasks that don't need a human to +perform. By removing the need for us to think about such things, we can focus on +those things which _do_ need a human; thus, we get more done, quicker. + +# Conventions + +The words MUST, SHOULD, MUST NOT, SHOULD NOT and MAY are defined as per [RFC +2119][rfc-2119]. + +# Tools + +## Compiler warning settings + +The following warnings MUST be enabled for all builds of any project, or any +project component: + +* ``-Wall`` +* ``-Wcompat`` +* ``-Wincomplete-uni-patterns`` +* ``-Wredundant-constraints`` +* ``-Werror`` + +Additionally, ``-Wincomplete-record-updates`` SHOULD be enabled for all builds +of any project. The only exception is when this warning would be spuriously +triggered by ``record-dot-preprocessor``, which occurs for definitions like +this: + +```haskell +data Foo = Bar { + baz :: Int, + quux :: String + } | + Quux +``` + +Additionally, ``-Wredundant-constraints`` SHOULD be enabled for all builds of +any project. Exceptions are allowed when the additional constraints are designed +to ensure safety, rather than due to reliance on any method. + +If a warning from this list is to be disabled, it MUST be disabled in the +narrowest possible scope; ideally, this SHOULD be a single module. + +### Justification + +These options are suggested by [Alexis King][alexis-king-options] - the +justifications for them can be found at the link. These fit well with our +motivations, and thus, should be used everywhere. The ``-Werror`` ensures that +warnings _cannot_ be ignored: this means that problems get fixed sooner. + +The two permissible exceptions stem from limitations in the record-dot plugin +(for ``-Wincomplete-record-updates``) and from the way redundant constraints are +detected; basically, unless a type class method from a constraint is used within +the body of the definition, or is required by anything called in a transitive +manner, the constraint is deemed redundant. Mostly, this is accurate, but some +type-level safety constraints can be deemed redundant as a result of this +approach. In this case, a limited lowering (per module ideally) of those two +warnings is acceptable, as they represent workarounds to technical problems, +rather than issues with the warnings themselves. + +## Linting + +Every source file MUST be free of warnings as produced by [HLint][hlint], with +default settings. + +### Justification + +HLint automates away the detection of many common sources of boilerplate and +inefficiency. It also describes many useful refactors, which in many cases make +the code easier to read and understand. As this is fully automatic, it saves +effort on our part, and ensures consistency across the codebase without us +having to think about it. + +## Code formatting + +Every source file MUST be formatted according to [Fourmolu][fourmolu], with the +following settings (as per its settings file): + +* ``indentation: 2`` +* ``comma-style: leading`` +* ``record-brace-space: true`` +* ``indent-wheres: true`` +* ``diff-friendly-import-export: true`` +* ``respectful: true`` +* ``haddock-style: multi-line`` +* ``newlines-between-decls: 1`` + +Each source code line MUST be at most 100 characters wide, and SHOULD +be at most 80 characters wide. + +### Justification + +Consistency is the most important goal of readable codebases. Having a single +standard, automatically enforced, means that we can be sure that everything will +look similar, and not have to spend time or mind-space ensuring that our code +complies. Additionally, as Ormolu is opinionated, anyone familiar with its +layout will find our code familiar, which eases the learning curve. + +Lines wider than 80 characters become difficult to read, especially when viewed +on a split screen. Sometimes, we can't avoid longer lines (especially with more +descriptive identifiers), but a line length of over 100 characters becomes +difficult to read even without a split screen. We don't _enforce_ a maximum of +80 characters for this exact reason; some judgment is allowed. + +# Code practices + +## Naming + +camelCase MUST be used for all non-type, non-data-constructor names; otherwise, +TitleCase MUST be used. Acronyms used as part of a naming identifier (such as +'JSON', 'API', etc) SHOULD be downcased; thus ``repairJson`` and +``fromHttpService`` are correct. Exceptions are allowed for external libraries +(Aeson's ``parseJSON`` for example). + +### Justification + +camelCase for non-type, non-data-constructor names is a long-standing convention +in Haskell (in fact, HLint checks for it); TitleCase for type names or data +constructors is _mandatory_. Obeying such conventions reduces cognitive load, as +it is common practice among the entire Haskell ecosystem. There is no particular +standard regarding acronym casing: examples of always upcasing exist (Aeson) as +well as examples of downcasing (``http-api-data``). One choice for consistency +(or as much as is possible) should be made however. + +## Modules + +All publically facing modules (namely, those which are not listed in +``other-modules`` in the Cabal file) MUST have explicit export lists. + +All modules MUST use one of the following conventions for imports: + +* ``import Foo (Baz, Bar, quux)`` +* ``import qualified Foo as F`` + +Data types from qualified-imported modules SHOULD be imported unqualified by +themselves: + +```haskell +import Data.Vector (Vector) +import qualified Data.Vector as Vector +``` + +The main exception is if such an import would cause a name clash: + +```haskell +-- no way to import both of these without clashing the Vector type name +import qualified Data.Vector as Vector +import qualified Data.Vector.Storable as VStorable +``` + +The _sole_ exception is a 'hiding import' to replace part of the functionality +of ``Prelude``: + +```haskell +-- replace the String-based readFile with a Text-based one +import Prelude hiding (readFile) +import Data.Text.IO (readFile) +``` + +Data constructors SHOULD be imported individually. For example, given the +following data type declaration: + +```haskell +module Quux where + +data Foo = Bar Int | Baz +``` + +Its corresponding import should be: + +```haskell +import Quux (Foo, Bar, Baz) +``` + +For type class methods, the type class and its methods MUST be imported +as so: + +```haskell +import Data.Aeson (FromJSON (fromJSON)) +``` + +Qualified imports SHOULD use the entire module name (that is, the last component +of its hierarchical name) as the prefix. For example: + +```haskell +import qualified Data.Vector as Vector +``` + +Exceptions are granted when: + +* The import would cause a name clash anyway (such as different ``vector`` + modules); or +* We have to import a data type qualified as well. + +Qualified imports of multiple modules MUST NOT be imported under the same name. +Thus, the following is wrong: + +```haskell +import qualified Foo.Bar as Baz +import qualified Foo.Quux as Baz +``` + +### Justification + +Explicit export lists are an immediate, clear and obvious indication of what +publically visible interface a module provides. It gives us stability guarantees +(namely, we know we can change things that aren't exported and not break +downstream code at compile time), and tells us where to go looking first when +inspecting or learning the module. Additionally, it means there is less chance +that implementation details 'leak' out of the module due to errors on the part +of developers, especially new developers. + +One of the biggest challenges for modules which depend on other modules +(especially ones that come from the project, rather than an external library) is +knowing where a given identifier's definition can be found. Having explicit +imports of the form described helps make this search as straightforward as +possible. This also limits cognitive load when examining the sources (if we +don't import something, we don't need to care about it in general). Lastly, +being explicit avoids stealing too many useful names. + +In general, type names occur far more often in code than function calls: we have +to use a type name every time we write a type signature, but it's unlikely we +use only one function that operates on said type. Thus, we want to reduce the +amount of extra noise needed to write a type name if possible. Additionally, +name clashes from function names are far more likely than name clashes from type +names: consider the number of types on which a ``size`` function makes sense. +Thus, importing type names unqualified, even if the rest of the module is +qualified, is good practice, and saves on a lot of prefixing. + +## Plutus module import naming conventions + +In addition to the general module import rules, we follow some conventions +on how we import the Plutus API modules, allowing for some flexibility +depending on the needs of a particular module. + +Modules under the names `Plutus`, `Ledger` and `Plutus.V1.Ledger` SHOULD +be imported qualified with their module name, as per the general module standards. +An exception to this is `Plutus.V1.Ledger.Api`, where the `Ledger` name is preferred. + +Some other exceptions to this are allowed where it may be more convenient to +avoid longer qualified names. + +For example: + +```haskell +import Plutus.V1.Ledger.Slot qualified as Slot +import Plutus.V1.Ledger.Tx qualified as Tx +import Plutus.V1.Ledger.Api qualified as Ledger +import Ledger.Oracle qualified as Oracle +import Plutus.Contract qualified as Contract +``` + +In some cases it may be justified to use a shortened module name: + +```haskell +import Plutus.V1.Ledger.AddressMap qualified as AddrMap +``` + +Modules under `PlutusTx` that are extensions to `PlutusTx.Prelude` MAY be +imported unqualified when it is reasonable to do so. + +The `Plutus.V1.Ledger.Api` module SHOULD be avoided in favour of more +specific modules where possible. For example, we should avoid: + +```haskell +import Plutus.V1.Ledger.Api qualified as Ledger (ValidatorHash) +``` + +In favour of: + +```haskell +import Plutus.V1.Ledger.Scripts qualified as Scripts (ValidatorHash) +``` + +### Justification + +The Plutus API modules can be confusing, with numerous modules involved, many +exporting the same items. Consistent qualified names help ease this problem, +and decrease ambiguity about where imported items come from. + +## LANGUAGE pragmata + +The following pragmata MUST be enabled at project level (that is, in +``package.yaml``): + +* ``BangPatterns`` +* ``BinaryLiterals`` +* ``ConstraintKinds`` +* ``DataKinds`` +* ``DeriveFunctor`` +* ``DeriveGeneric`` +* ``DeriveTraversable`` +* ``DerivingStrategies`` +* ``DuplicateRecordFields`` +* ``EmptyCase`` +* ``FlexibleContexts`` +* ``FlexibleInstances`` +* ``GADTs`` +* ``GeneralizedNewtypeDeriving`` +* ``HexFloatLiterals`` +* ``InstanceSigs`` +* ``ImportQualifiedPost`` +* ``KindSignatures`` +* ``LambdaCase`` +* ``MultiParamTypeClasses`` +* ``NoImplicitPrelude`` +* ``NumericUnderscores`` +* ``OverloadedStrings`` +* ``StandaloneDeriving`` +* ``TupleSections`` +* ``TypeApplications`` +* ``TypeOperators`` +* ``TypeSynonymInstances`` +* ``UndecidableInstances`` + +Any other LANGUAGE pragmata MUST be enabled per-file. All language pragmata MUST +be at the top of the source file, written as ``{-# LANGUAGE PragmaName #-}``. + +Furthermore, the following pragmata MUST NOT be used, or enabled, anywhere: + +* ``DeriveDataTypeable`` +* ``DeriveFoldable`` +* ``PartialTypeSignatures`` +* ``PostfixOperators`` + +### Justification + +``DataKinds``, ``DuplicateRecordFields``, ``GADTs``, ``TypeApplications``, +``TypeSynonymInstances`` and ``UndecidableInstances`` are needed globally to use +the GHC plugin from ``record-dot-preprocessor``. While some of these extensions +are undesirable to use globally, we end up needing them anyway, so we can't +really avoid this. + +``BangPatterns`` are a much more convenient way to force evaluation than +repeatedly using `seq`. Furthemore, they're not confusing, and are considered +ubiquitous enough for ``GHC2021``. Having them on by default simplifies a lot of +performance tuning work, and they don't really need signposting. + +``BinaryLiterals``, ``HexFloatLiterals`` and ``NumericUnderscores`` all simulate +features that are found in many other programming languages, and that are +extremely convenient in a range of settings, ranging from dealing with large +numbers to bit-twiddling. If anything, it is more surprising and annoying when +these _aren't_ enabled, and should really be part of Haskell syntax anyway. +Enabling this project-wide actually encourages better practice and readability. + +The kind ``Constraint`` is not in Haskell2010, and thus, isn't recognized by +default. While working with constraints as first-class objects isn't needed +often, this extension effectively exists because Haskell2010 lacks exotic kinds +altogether. Since we require explicit kind signatures (and foralls) for all type +variables, this needs to be enabled as well. There is no harm in enabling this +globally, as other rich kinds (such as ``Symbol`` or ``Nat``) don't require an +extension for their use, and this doesn't change any behaviour (``Constraint`` +exists whether you enable this extension or not, as do 'exotic kinds' in +general). + +``DerivingStrategies`` is good practice (and in fact, is mandated by this +document); it avoids ambiguities between ``GeneralizedNewtypeDeriving`` and +``DeriveAnyClass``, allows considerable boilerplate savings through use of +``DerivingVia``, and makes the intention of the derivation clear on immediate +reading, reducing the amount of non-local information about derivation +priorities that we have to retain. ``DeriveFunctor`` and +``GeneralizedNewtypeDeriving`` are both obvious and useful extensions to the +auto-derivation systems available in GHC. Both of these have only one correct +derivation (the former given by [parametricity +guarantees][functor-parametricity], the latter by the fact that a newtype only +wraps a single value). As there is no chance of unexpected behaviour by these, +no possible behaviour variation, and that they're key to supporting both the +``stock`` and ``newtype`` deriving stratgies, having these on by default removes +considerable tedium and line noise from our code. A good example are newtype +wrappers around monadic stacks: + +```haskell +newtype FooM a = FooM (ReaderT Int (StateT Text IO) a) + deriving newtype ( + Functor, + Applicative, + Monad, + MonadReader Int, + MonadState Text, + MonadIO + ) +``` + +Deriving ``Traversable`` is a little tricky. While ``Traversable`` is lawful +(though not to the degree ``Functor`` is, permitting multiple implementations in +many cases), deriving it is complicated by issues of role assignation for +higher-kinded type variables and the fact that you can't ``coerce`` through a +``Functor``. These are arguably implementation issues, but repairing this +situation requires cardinal changes to ``Functor``, which is unlikely to ever +happen. Even newtype or via derivations of ``Traversable`` are mostly +impossible; thus, we must have special support from GHC, which +``DeriveTraversable`` enables. This is a very historically-motivated +inconsistency, and should really not exist at all. While this only papers over +the problem (as even with this extension on, only stock derivations become +possible), it at least means that it can be done at all. Having it enabled +globally makes this inconsistency slightly less visible, and is completely safe. + +While GHC ``Generic``s are far from problem-free, many parts of the Haskell +ecosystem require ``Generic``, either as such (c.f. ``beam-core``) or for +convenience (c.f ``aeson``, ``hashable``). Additionally, several core parts of +Plutus (including ``ToSchema``) are driven by ``Generic``. The derivation is +trivial in most cases, and having to enable an extension for it is quite +annoying. Since no direct harm is done by doing this, and use of ``Generic`` is +already signposted clearly (and is mostly invisible), having this on globally +poses no problems. + +``EmptyCase`` not being on by default is an inconsistency of Haskell 2010, as +the report allows us to define an empty data type, but without this extension, +we cannot exhaustively pattern match on it. This should be the default behaviour +for reasons of symmetry. + +``FlexibleContexts`` and ``FlexibleInstances`` paper over a major deficiency of +Haskell2010, which in general isn't well-motivated. There is no real reason to +restrict type arguments to variables in either type class instances or type +signatures: the reasons for this choice in Haskell2010 are entirely for the +convenience of the implementation. It produces no ambiguities, and in many ways, +the fact this _isn't_ the default is more surprising than anything. +Additionally, many core libraries rely on one, or both, of these extensions +being enabled (``mtl`` is the most obvious example, but there are many others). +Thus, even for popularity and compatibility reasons, these should be on by +default. + +``InstanceSigs`` are harmless by default, and introduce no complications. Their +not being default is strange. ``ImportQualifiedPost`` is already a convention +of this project, and helps with formatting of imports. + +``KindSignatures`` become extremely useful in any setting where 'exotic kinds' +(meaning, anything which isn't `Type` or `Type -> Type` or similar) are +commonplace; much like type signatures clarify expectations and serve as active +documentation (even where GHC can infer them), explicit kind signatures serve +the same purpose 'one level up'. When combined with the requirement to provide +explicit foralls for type variables defined in this document, they simplify the +usage of 'exotic kinds' and provide additional help from both the type checker +and the code. Since this project is Plutus-based, we use 'exotic kinds' +extensively, especially in row-polymorphic records; thus, in our case, this is +especially important. This also serves as justification for +`ScopedTypeVariables`, as well as ironing out a weird behaviour where in cases +such as + +```haskell +foo :: a -> b +foo = bar . baz + where + bar :: String -> b + bar = ... + baz :: a -> String + baz = ... +``` + +cause GHC to produce _fresh_ type variables in each ``where``-bind. This is +confusing and makes little sense - if the user wanted a fresh variable, they +would name it that way. What's worse is that the type checker emits an error +that makes little sense (except to those who have learned to look for this +error), creating even more confusion, especially in cases where the type +variable is constrained: + +```haskell +foo :: (Monoid m) => m -> String +foo = bar . baz + where + baz :: m -> Int + baz = ... -- this has no idea that m is a Monoid, since m is fresh! +``` + +``LambdaCase`` reduces a lot of code in the common case of analysis of sum +types. Without it, we are forced to either write a dummy ``case`` argument: + +```haskell +foo s = case s of +-- rest of code here +``` + +Or alternatively, we need multiple heads: + +```haskell +foo Bar = -- rest of code +foo (Baz x y) = -- rest of code +-- etc +``` + +``LambdaCase`` is shorter than both of these, and avoids us having to bind +variables, only to pattern match them away immediately. It is convenient, clear +from context, and really should be part of the language to begin with. + +``MultiParamTypeClasses`` are required for a large number of standard Haskell +libraries, including ``mtl`` and ``vector``, and in many situations. Almost any +project of non-trivial size must have this extension enabled somewhere, and if +the code makes significant use of ``mtl``-style monad transformers or defines +anything non-trivial for ``vector``, it must use it. Additionally, it arguably +lifts a purely implementation-driven decision of the Haskell 2010 language, much +like ``FlexibleContexts`` and ``FlexibleInstances``. Lastly, although it can +introduce ambiguity into type checking, it only applies when we want to define +our own multi-parameter type classes, which is rarely necessary. Enabling it +globally is thus safe and convenient. + +Based on the recommendations of this document (driven by the needs of the +project and the fact it's cardinally connected with Plutus), +``NoImplicitPrelude`` is required to allow us to default to the Plutus prelude +instead of the one from ``base``. + +``OverloadedStrings`` deals with the problem that ``String`` is a suboptimal +choice of string representation for basically _any_ problem, with the general +recommendation being to use ``Text`` instead. It is not, however, without its +problems: + +* ``ByteString``s are treated as ASCII strings by their ``IsString`` instance; +* Overly polymorphic behaviour of many functions (especially in the presence of + type classes) forces extra type signatures; + +These are usually caused not by the extension itself, but by other libraries and +their implementations of either ``IsString`` or overly polymorphic use of type +classes without appropriate laws (Aeson's ``KeyValue`` is a particularly +egregious offender here). The convenience of this extension in the presence of +literals, and the fact that our use cases mostly covers ``Text``, makes it worth +using by default. + +``StandaloneDeriving`` is mostly needed for GADTs, or situations where complex +type-level computations drive type class instances, requiring users to specify +constraints manually. This can pose some difficulties syntactically (such as +with deriving strategies), but isn't a problem in and of itself, as it doesn't +really change how the language works. Having this enabled globally is not +problematic. + +``TupleSections`` smooths out an oddity in the syntax of Haskell 2010 regarding +partial application of tuple constructors. Given a function like ``foo :: Int -> String -> +Bar``, we accept it as natural that we can write ``foo 10`` to get a function of +type ``String -> Bar``. However, by default, this logic doesn't apply to tuple +constructors. As special cases are annoying to keep track of, and in this case, +serve no purpose, as well as being clear from their consistent use, this should +also be enabled by default; it's not clear why it isn't already. + +``TypeOperators`` is practically a necessity when dealing with type-level +programming seriously. Much how infix data constructors are extremely useful +(and sometimes clearer than their prefix forms), infix _type_ constructors serve +a similar functionality. Additionally, Plutus relies on operators at the type +level significantly - for example, it's not really possible to define a +row-polymorphic record or variant without them. Having to enable this almost +everywhere is a needless chore, and having type constructors behaving +differently to data constructors here is a needless source of inconsistency. + +We exclude ``DeriveDataTypeable``, as ``Data`` is a strictly-worse legacy +version of ``Generic``, and ``Typeable`` no longer needs deriving for anything +anyway. The only reason to derive either of these is for compatibility with +legacy libraries, which we don't have any of, and the number of which shrinks +every year. If we're using this extension at all, it's probably a mistake. + +``Foldable`` is possibly the most widely-used lawless type class. Its only laws +are about self-consistency (such as agreement between ``foldMap`` and +``foldr``), but unlike something like ``Functor``, ``Foldable`` doesn't have any +laws specifying its behaviour outside of 'it compiles'. As a result, even if we +accept its usefulness (a debatable position in itself), there are large numbers +of possible implementations that could be deemed 'valid'. The approach taken by +``DeriveFoldable`` is _one_ such approach, but this requires knowing its +derivation algorithm, and may well not be something you need. Unlike a +``Functor`` derivation (whose meaning is obvious), a ``Foldable`` one is +anything but, and requires referencing a lot of non-local information to +determine how it will behave (especially for the 'richer' ``Foldable``, with +many additional methods). If you need a ``Foldable`` instance, you will either +newtype or via-derive it (which doesn't need this extension anyway), or you'll +write your own (which _also_ doesn't need this extension). Enabling this +encourages bad practices, is confusing, and ultimately doesn't really benefit +anything. + +``PartialTypeSignatures`` is a misfeature. Allowing leaving in type holes (to be +filled by GHC's inference algorithm) is an anti-pattern for the same reason that +not providing top-level signatures: while it's possible (mostly) for GHC to +infer signatures, we lose considerable clarity and active documentation by doing +so, in return for (quite minor) convenience. While the use of typed holes during +development is a good practice, they should not remain in final code. Given that +Plutus projects require us to do some fairly advanced type-level programming +(where inference often _fails_), this extension can often provide totally +incorrect results due to GHC's 'best-effort' attempts at type checking. There is +no reason to leave behind typed holes instead of filling them in, and we +shouldn't encourage this. + +``PostfixOperators`` are arguably a misfeature. Infix operators already require +a range of special cases to support properly (what symbols create an infix +operator, importing them at the value and type level, etc), which postfix +operators make _worse_. Furthermore, they are seldom, if ever, used, and +typically aren't worth the trouble. Haskell is not Forth, none of our +dependencies rely on postfix operators, and defining our own creates more +problems than it solves. + +## ``record-dot-preprocessor`` + +The GHC plugin from ``record-dot-preprocessor`` SHOULD be enabled globally. + +### Justification + +Haskell records are documentedly and justifiably subpar: the [original issue for +the record dot preprocessor extension][rdp-issue] provides a good summary of the +reasons. While a range of extensions (including ``DuplicateRecordFields``, +``DisambiguateRecordFields``, ``NamedFieldPuns``, and many others) have been +proposed, and accepted, to mitigate the situation, the reality is that, even +with them in place, use of records in Haskell is considerably more difficult, +and less flexible, than in any other language in widespread use today. The +proposal described in the previous link provides a solution which is familiar to +users of most other languages, and addresses the fundamental issue that makes +Haskell records so awkward. + +While the proposal for the record dot syntax that this preprocessor enables is +coming, it's not available in the current version of Haskell used by Plutus (and +thus, transitively, by us). Additionally, the earliest this will be available is +GHC 9.2, and given that our dependencies must support this version too, it'll be +considerable time before we can get its benefits. The preprocessor gives us +these benefits immediately, at some dependency cost. While it's not a perfect +process, as it involves enabling several questionable extensions, and can +require disabling an important warning, it significantly reduces issues with +record use, making it worthwhile. Additionally, when GHC 9.2 becomes usable, we +can upgrade to it seamlessly. + +## Prelude + +The ``PlutusTx.Prelude`` MUST be used. A 'hiding import' to remove functionality +we want to replace SHOULD be used when necessary. If functionality from the +``Prelude`` in ``base`` is needed, it SHOULD be imported qualified. Other +preludes MUST NOT be used. + +### Justification + +As this is primarily a Plutus project, we are in some ways limited by what +Plutus requires (and provides). Especially for on-chain code, the Plutus prelude +is the one we need to use, and therefore, its use should be as friction-free as +possible. As many modules may contain a mix of off-chain and on-chain code, we +also want to make impendance mismatches as limited as possible. + +By the very nature of this project, we can assume a familiarity (or at least, +the goal of such) with Plutus stuff. Additionally, _every_ Haskell developer is +familiar with the ``Prelude`` from ``base``. Thus, any replacements of the +Plutus prelude functionality with the ``base`` prelude should be clearly +indicated locally. + +Haskell is a 30-year-old language, and the ``Prelude`` is one of its biggest +sources of legacy. A lot of its defaults are questionable at best, and often +need replacing. As a consequence of this, a range of 'better ``Prelude``s' have +been written, with a range of opinions: while there is a common core, a large +number of decisions are opinionated in ways more appropriate to the authors of +said alternatives and their needs than those of other users of said +alternatives. This means that, when a non-``base`` ``Prelude`` is in scope, it +often requires familiarity with its specific decisions, in addition to whatever +cognitive load the current module and its other imports impose. Given that we +already use an alternative prelude (in tandem with the one from ``base``), +additional alternatives present an unnecessary cognitive load. Lastly, the +dependency footprint of many alternative ``Prelude``s is _highly_ non-trivial; +it isn't clear if we need all of this in our dependency tree. + +For all of the above reasons, the best choice is 'default to Plutus, with local +replacements from `base`'. + +## Versioning + +A project MUST use the [PVP][pvp]. Two, and only two, version numbers MUST be +used: a major version and a minor version. + +### Justification + +The [Package Versioning Policy][pvp] is the conventional Haskell versioning +scheme, adopted by most packages on Hackage. It is clearly described, and even +automatically verifiable by use of tools like [``policeman``][policeman]. Thus, +adopting it is both in line with community standards (making it easier to +remember), and simplifies cases such as Hackage publication or open-sourcing in +general. + +Two version numbers (major and minor) is the minimum allowed by the PVP, +indicating compilation-breaking and compilation-non-breaking changes +respectively. As parsimony is best, and more granularity than this isn't +generally necessary, adopting this model is the right decision. + +## Documentation + +Every publically-exported definition MUST have a Haddock comment, detailing its +purpose. If a definition is a function, it SHOULD also have examples of use +using [Bird tracks][bird-tracks]. The Haddock for a publically-exported +definition SHOULD also provide an explanation of any caveats, complexities of +its use, or common issues a user is likely to encounter. + +If the code project is a library, these Haddock comments SHOULD carry an +[``@since``][haddock-since] annotation, stating what version of the library they +were introduced in, or the last version where their functionality or type +signature changed. + +For type classes, their laws MUST be documented using a Haddock comment. + +### Justification + +Code reading is a difficult task, especially when the 'why' rather than the +'how' of the code needs to be deduced. A good solution to this is documentation, +especially when this documentation specifies common issues, provides examples of +use, and generally states the rationale behind the definition. + +For libraries, it is often important to inform users what changed in a given +version, especially where 'major bumps' are concerned. While this would ideally +be addressed with accurate changelogging, it can be difficult to give proper +context. ``@since`` annotations provide a granular means to indicate the last +time a definition changed considerably, allowing someone to quickly determine +whether a version change affects something they are concerned with. + +As stated elsewhere in the document, type classes having laws is critical to our +ability to use equational reasoning, as well as a clear indication of what +instances are and aren't permissible. These laws need to be clearly stated, as +this assists both those seeking to understand the purpose of the type class, and +also the expected behaviour of its instances. + +## Other + +Lists SHOULD NOT be field values of types; this extends to ``String``s. Instead, +``Vector``s (``Text``s) SHOULD be used, unless a more appropriate structure exists. +On-chain code, due to a lack of alternatives, is one place lists can be used as +field values of types. + +Partial functions MUST NOT be defined. Partial functions SHOULD NOT be used +except to ensure that another function is total (and the type system cannot be +used to prove it). + +Derivations MUST use an explicit [strategy][deriving-strategies]. Thus, the +following is wrong: + +```haskell +newtype Foo = Foo (Bar Int) + deriving (Eq, Show, Generic, FromJSON, ToJSON, Data, Typeable) +``` + +Instead, write it like this: + +```haskell +newtype Foo = Foo (Bar Int) + deriving stock (Generic, Data, Typeable) + deriving newtype (Eq, Show) + deriving anyclass (FromJSON, ToJSON) +``` + +Deriving via SHOULD be preferred to newtype derivation, especially where the +underlying type representation could change significantly. + +``type`` SHOULD NOT be used. The only acceptable case is abbreviation of large +type-level computations. In particular, using ``type`` to create an abstraction +boundary MUST NOT be done. + +Type variables MUST have an explicit ``forall`` scoping it, and all type +variables MUST have kind signatures explicitly provided. Thus, the following is +wrong: + +```haskell +data Foo a = Bar | Baz [a] + +quux :: (Monoid m) => [m] -> m -> m +``` + +Instead, write it like this: + +```haskell +data Foo (a :: Type) = Bar | Baz [a] + +quux :: forall (m :: Type) . (Monoid m) => [m] -> m -> m +``` + +`where`-bindings MUST have type signatures. + +### Justification + +Haskell lists are a large example of the legacy of the language: they (in the +form of singly linked lists) have played an important role in the development of +functional programming (and for some 'functional' languages, continue to do so). +However, from the perspective of data structures, they are suboptimal except for +_extremely_ specific use cases. In almost any situation involving data (rather +than control flow), an alternative, better structure exists. Although it is both +acceptable and efficient to use lists within functions (due to GHC's extensive +fusion optimizations), from the point of view of field values, they are a poor +choice from both an efficiency perspective, both in theory _and_ in practice. +For almost all cases where you would want a list field value, a ``Vector`` field +value is more appropriate, and in almost all others, some other structure (such +as a ``Map``) is even better. We make a named exception for on-chain code, as no +alternatives presently exist. + +Partial functions are runtime bombs waiting to explode. The number of times the +'impossible' happened, especially in production code, is significant in our +experience, and most partiality is easily solvable. Allowing the compiler to +support our efforts, rather than being blind to them, will help us write more +clear, more robust, and more informative code. Partiality is also an example of +legacy, and it is legacy of _considerable_ weight. Sometimes, we do need an +'escape hatch' due to the impossibility of explaining what we want to the +compiler; this should be the _exception_, not the rule. + +Derivations are one of the most useful features of GHC, and extend the +capabilities of Haskell 2010 considerably. However, with great power comes great +ambiguity, especially when ``GeneralizedNewtypeDeriving`` is in use. While there +_is_ an unambiguous choice if no strategy is given, it becomes hard to remember. +This is especially dire when ``GeneralizedNewtypeDeriving`` combines with +``DeriveAnyClass`` on a newtype. Explicit strategies give more precise control +over this, and document the resulting behaviour locally. This reduces the number +of things we need to remember, and allows more precise control when we need it. +Lastly, in combination with ``DerivingVia``, considerable boilerplate can be +saved; in this case, explicit strategies are _mandatory_. + +The only exception to the principle above is newtype deriving, which can +occasionally cause unexpected problems; if we use a newtype derivation, and +change the underlying type, we get no warning. Since this can affect the effect +of some type classes drastically, it would be good to have the compiler check +our consistency. + +``type`` is generally a terrible idea in Haskell. You don't create an +abstraction boundary with it (any operations on the 'underlying type' still work +over it), and compiler output becomes _very_ inconsistent (sometimes showing the +``type`` definition, sometimes the underlying type). If your goal is to create +an abstraction boundary with its own operations, ``newtype`` is both cost-free +and clearer; if that is _not_ your goal, just use the type you'd otherwise +rename, since it's equivalent semantically. The only reasonable use of ``type`` +is to hide complex type-level computations, which would otherwise be too long. +Even this is somewhat questionable, but the questionability comes from the +type-level computation being hidden, not ``type`` as such. + +Type-level programming is mandated in many places by Plutus (including, but not +limited to, row-polymorphic records and variants from `Data.Row`). This often +requires use of ``TypeApplications``, which essentially makes not only the type +variables, but their _order_, part of the API of any definition that uses them. +While there is an algorithm determining this precisely, something that is +harmless at the value level (such as re-ordering constraints) could potentially +serve as an API break. Additionally, this algorithm is a huge source of +non-local information, and in the presence of a large number of type variables, +of different kinds, can easily become confusing. Having explicit foralls +quantifying all type variables makes it clear what the order for these type +variables is for ``TypeApplications``, and also allows us to choose it +optimally for our API, rather than relying on what the algorithm would produce. +This is significantly more convenient, and means less non-local information and +confusion. + +Additionally, type-level programming requires significant use of 'exotic kinds', +which in our case include ``Constraint -> Type`` and ``Row Type``, to name but a +few. While GHC can (mostly) infer kind signatures, much the same way as we +explicitly annotate type signatures as a form of active documentation (and to +assist the type checker when using type holes), explicitly annotating _kind_ +signatures allows us to be clear to the users where exotic kinds are expected, +as well as ensuring that we don't make any errors ourselves. This, together with +explicit foralls, essentially bring the same practices to the kind level as the +Haskell community already considers to be good at the type level. + +`where` bindings are quite common in idiomatic Haskell, and quite often contain +non-trivial logic. They're also a common refactoring, and 'hole-driven +development' tool, where you create a hole to be filled with a `where`-bound +definition. Even in these cases, having an explicit signature on +`where`-bindings helps: during development, you can use typed holes inside the +`where`-binding with useful information (absent a signature, you'll get +nothing), and it makes the code much easier to understand, especially if the +`where`-binding is complex. It's also advantageous when 'promoting' +`where`-binds to full top-level definitions, as the signature is already there. +Since we need to do considerable type-level programming as part of Plutus, this +becomes even more important, as GHC's type inference algorithm can often fail in +those cases on `where`-bindings, which will sometimes fail to derive, giving a +very strange error message, which would need a signature to solve anyway. By +making this practice proactive, we are decreasing confusion, as well as +increasing readability. While in theory, this standard should extend to +`let`-bindings as well, these are much rarer, and can be given signatures with +`::` if `ScopedTypeVariables` is on (which it is for us by default) if needed. + +# Design practices + +## Parse, don't validate + +[Boolean blindness][boolean-blindness] SHOULD NOT be used in the design of any +function or API. Returning more meaningful data SHOULD be the preferred choice. +The general principle of ['parse, don't validate'][parse-dont-validate] SHOULD +guide design and implementation. + +### Justification + +The [description of boolean blindness][boolean-blindness] gives specific reasons why it is a poor +design choice; additionally, it runs counter to the principle of ['parse, don't +validate][parse-dont-validate]. While sometimes unavoidable, in many cases, it's +possible to give back a more meaningful response than 'yes' or 'no, and we +should endeavour to do this. Designs that avoid boolean blindness are more +flexible, less bug-prone, and allow the type checker to assist us when writing. +This, in turn, reduces cognitive load, improves our ability to refactor, and +means fewer bugs from things the compiler _could_ have checked if a function +_wasn't_ boolean-blind. + +## No multi-parameter type-classes without functional dependencies + +Any multi-parameter type class MUST have a functional dependency restricting its +relation to a one-to-many at most. In cases of true many-to-many relationships, +type classes MUST NOT be used as a solution to the problem. + +### Justification + +Multi-parameter type classes allow us to express more complex relationships +among types; single-parameter type classes effectively permit us to 'subset' +``Hask`` only. However, multi-parameter type classes make type inference +_extremely_ flakey, as the global coherence condition can often lead to the +compiler being unable to determine what instance is sought even if all the type +parameters are concrete, due to anyone being able to add a new instance at any +time. This is largely caused by multi-parameter type classes defaulting to +effectively representing arbitrary many-to-many relations. + +When we do not _have_ arbitrary many-to-many relations, multi-parameter type +classes are useful and convenient. We can indicate this using functional +dependencies, which inform the type checker that our relationship is not +arbitrarily many-to-many, but rather many-to-one or even one-to-one. This is a +standard practice in many libraries (``mtl`` being the most ubiquitous example), +and allows us the benefits of multi-parameter type classes without making type +checking confusing and difficult. + +In general, many-to-many relationships pose difficult design choices, for which +type classes are _not_ the correct solution. If a functional dependency _cannot_ +be provided for a type class, it suggests that the current design relies +inherently on a many-to-many relation, and should be either rethought to +eliminate it, or be dealt with using a more appropriate means. + +## Type classes must have laws + +Any type class not imported from an external dependency MUST have laws. These +laws MUST be documented in a Haddock comment on the type class definition, and +all instances MUST follow these laws. + +### Justification + +Type classes are a powerful feature of Haskell, but can also be its most +confusing. As they allow arbitrary ad-hoc polymorphism, and are globally +visible, it is important that we limit the confusion this can produce. +Additionally, type classes without laws inhibit equational reasoning, which is +one of Haskell's biggest strengths, _especially_ in the presence of what amounts +to arbitrary ad-hoc polymorphism. + +Additionally, type classes with laws allow the construction of _provably_ +correct abstractions above them. This is also a common feature in Haskell, +ranging from profunctor optics to folds. If we define our own type classes, we +want to be able to abstract above them with _total_ certainty of correctness. +Lawless type classes make this difficult to do: compare the number of +abstractions built on `Functor` or `Traversable` as opposed to `Foldable`. + +Thus, type classes having laws provides both ease of understanding and +additional flexibility. + +[pvp]: https://pvp.haskell.org/ +[policeman]: https://hackage.haskell.org/package/policeman +[haddock-since]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#since +[bird-tracks]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#code-blocks +[hedgehog-classes]: http://hackage.haskell.org/package/hedgehog-classes +[hspec-hedgehog]: http://hackage.haskell.org/package/hspec-hedgehog +[property-based-testing]: https://dl.acm.org/doi/abs/10.1145/1988042.1988046 +[hedgehog]: http://hackage.haskell.org/package/hedgehog +[deriving-strategies]: https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/deriving-strategies +[functor-parametricity]: https://www.schoolofhaskell.com/user/edwardk/snippets/fmap +[alexis-king-options]: https://lexi-lambda.github.io/blog/2018/02/10/an-opinionated-guide-to-haskell-in-2018/#warning-flags-for-a-safe-build +[hlint]: http://hackage.haskell.org/package/hlint +[fourmolu]: http://hackage.haskell.org/package/fourmolu +[rfc-2119]: https://tools.ietf.org/html/rfc2119 +[boolean-blindness]: http://dev.stephendiehl.com/hask/#boolean-blindness +[parse-dont-validate]: https://lexi-lambda.github.io/blog/2019/11/05/parse-don-t-validate/ +[hspec]: http://hackage.haskell.org/package/hspec +[rdp]: https://hackage.haskell.org/package/record-dot-preprocessor +[rdp-issue]: https://github.com/ghc-proposals/ghc-proposals/pull/282 diff --git a/mlabs/.gitignore b/mlabs/.gitignore index fa050c17c..f226225d7 100644 --- a/mlabs/.gitignore +++ b/mlabs/.gitignore @@ -1,3 +1,8 @@ dist-newstyle/ .stack-work/ +demo-frontend/.spago +demo-frontend/output +demo-frontend/node_modules +demo-frontend/.cache +demo-frontend/dist stack.yaml.lock diff --git a/mlabs/Makefile b/mlabs/Makefile index 6d0f3a151..c86b1ffd4 100644 --- a/mlabs/Makefile +++ b/mlabs/Makefile @@ -19,6 +19,10 @@ test-watch: # Target to use as dependency to fail if not inside nix-shell requires_nix_shell: - @ [ -v IN_NIX_SHELL ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" - @ [ -v IN_NIX_SHELL ] || (echo " run 'nix-shell --pure' first" && false) + @ [ "($IN_NIX_SHELL)" ] || echo "The $(MAKECMDGOALS) target must be run from inside nix-shell" + @ [ "($IN_NIX_SHELL)" ] || (echo " run 'nix-shell --pure' first" && false) +# Generate TOC for README.md +# It has to be manually inserted into the README.md for now. +readme_contents: + nix-shell -p nodePackages.npm --command "npx markdown-toc ./README.md --no-firsth1" diff --git a/mlabs/README.md b/mlabs/README.md new file mode 100644 index 000000000..f70c76a6a --- /dev/null +++ b/mlabs/README.md @@ -0,0 +1,329 @@ +# MLabs: Plutus Use Cases + +-------------------------------------------------------------------------------- + +## Contents + +- [MLabs: Plutus Use Cases](#mlabs-plutus-use-cases) + - [Contents](#contents) + - [Overview](#overview) + - [Prerequisites](#prerequisites) + - [Building, Testing, Use](#building-testing-use) + - [On Unix Systems](#on-unix-systems) + - [Documentation](#documentation) + - [Testing](#testing) + - [Running Tests](#running-tests) + - [Use Case: Lendex](#use-case-lendex) + - [Lendex: Description](#lendex-description) + - [Lendex: Progress & Planning](#lendex-progress--planning) + - [Lendex: Examples](#lendex-examples) + - [Lendex: APIs & Endpoints](#lendex-apis--endpoints) + - [Lendex: Tests](#lendex-tests) + - [Lendex: Notes](#lendex-notes) + - [Use Case: NFT](#use-case-nft) + - [NFT: Description](#nft-description) + - [NFT: Progress & Planning](#nft-progress--planning) + - [NFT: Examples](#nft-examples) + - [NFT: APIs & Endpoints](#nft-apis--endpoints) + - [NFT: Tests](#nft-tests) + - [NFT: Notes](#nft-notes) + +*note: the table of contents is generated using `make readme_contents`, please +update as headings are expanded.* + +-------------------------------------------------------------------------------- + +## Overview + +MLabs has been working on developing two Plutus Use cases, specifically: + +- [Use Case: Lendex](#use-case-lendex) based on the specification of + [Plutus Use case 3](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-3-lending-and-borrowing-collateral-escrow-flashloans). + +- [Use Case: NFT](#use-case-nft) based on the specification of + [Plutus Use case 5](https://github.com/mlabs-haskell/plutus-use-cases/tree/documentation#use-case-5-nfts-minting-transfer-buying-and-selling-nfts). + +Please refer to each individual Plutus Use Case for more specific information. + +### Prerequisites + +- Git +- Curl +- Nix + +### Building, Testing, Use + +# HLS setup (tested for Visual Studio Code) +Start editor from nix-shell. Let the editor find the correct version of haskell-language-server binary. +#### On Unix Systems + +*It is recommended that all current updates to your system be done before +installation* + +1) ***Install basic dependencies*** + +```bash +sudo apt install curl +sudo apt install git +``` + +2) ***Clone Directory*** + +Create a directory and clone the project: + +```bash +git clone https://github.com/mlabs-haskell/plutus-use-cases.git +``` + +3) ***Install Nix*** + + 1) **Setup Nix** + + ```bash + $ curl -L https://nixos.org/nix/install | sh + ``` + - *There is a issue with nix correctly adjusting the PATH in some machines. + Please re-start your terminal and make sure Nix is in the path (`nix --version`). + See this discussion if you are having this issue: [https://github.com/NixOS/nix/issues/3317](https://github.com/NixOS/nix/issues/3317).* + + - *The direct link to the nix download page for reference: [https://nixos.org/download.html](https://nixos.org/download.html).* + + 2) **Set up binary cache** + + **note: Make sure to set up the IOHK binary cache. If you do not do this, you + will end up building GHC, which takes several hours. If you find + yourself building GHC, STOP and fix the cache.** + + - To set up the binary cache: + + * On **non-NixOS** machines: + + Create a nix directory and file in the `etc` directory. + + 1) `sudo mkdir /etc/nix` + + 2) `sudo touch /etc/nix/nix.conf` + + *Then edit your `nix.conf` file to add:* + + `substituters = https://hydra.iohk.io https://iohk.cachix.org https://cache.nixos.org/` + `trusted-public-keys = hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ= iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo= cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=` + + + * On **NixOS** Machines, add the following NixOs options: + + `nix = { + binaryCaches = [ "https://hydra.iohk.io" "https://iohk.cachix.org" ];` + `binaryCachePublicKeys = [ "hydra.iohk.io:f/Ea+s+dFdN+3Y/G+FDgSq+a5NEWhJGzdjvKNGv0/EQ=" "iohk.cachix.org-1:DpRUyj7h7V830dp/i6Nti+NEO2/nhblbov/8MW7Rqoo=" ]; + };` + +Please see the original documentation at IOHK for reference: +- [How to set up the IOHK binary caches](https://github.com/input-output-hk/plutus/blob/master/README.adoc#iohk-binary-cache) + +4) ***Create nix shell*** + +Go to the `plutus-use-cases/mlabs` directory run the `nix-shell` command: +```bash + $ nix-shell +``` +- *note: This will take some time on the first run, as the dependencies get built locally.* + +### Documentation +Currently the documentation is done via this document which can +be found in the [MLabs gitHub repository](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs) + +### Testing +For an overview of the test coverage and implementation refer to the individual +cases documentation and the [test folder](https://github.com/mlabs-haskell/plutus-use-cases/tree/main/mlabs/test). + +#### Running Tests +*TODO: Add the explanation of how to run tests* + +-------------------------------------------------------------------------------- + +## Use Case: Lendex + +### Lendex: Description + +The Lendex Use Case is based on the Open Source, Non-Custodial Aave Protocol, +described in the [Aave Protocol +Whitepaper](https://github.com/aave/aave-protocol/blob/master/docs/Aave_Protocol_Whitepaper_v1_0.pdf). +The use case can be summarised as a platform for a decentralised, pool-based, +loan strategy. + +As described in the whitepaper, the model relies on Lenders depositing (Cardano) +cryptocurrency in a Pool Contract. The same Pool Contract provides a source for +funds to be borrowed by Borrowers through the placement of a collateral. Loans do +not need to be individually matched, but rather rely on the pooled funds, the +amounts borrowed and their respective collateral. The model enables instant +loans and the interest rate for both borrowers and lenders is decided +algorithmically. A general description of the interest algorithm is: + +- Borrower's interest is tied to the amount of funds available in the pool at + a specific time - with scarcity of funds driving the interest rate up. +- Lender's interest rate corresponds to the earn rate, with the algorithm + safeguarding a liquidity reserve to guarantee ease of withdrawals at any + given time. + +### Lendex: Progress & Planning + +- Goals and status: + - Development + - [x] Feature Completeness as per Specifications + - [ ] Improve Deployment Story + - [ ] Improve Performance + - [ ] Improve Ergonomics of Use and Installation + + - Testing + - [x] 100% Test Coverage + - [ ] QuickCheck Testing + + - Documentation + - [x] Example + - [ ] APIs + +### Lendex: Examples + +- [Lendex Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/lendex-demo/Main.hs) + - to run the `lendex-demo` run the following command from the root folder: + + ```bash + cd mlabs \ + && nix-shell --command "cabal v2-repl lendex-demo" + ``` + +Are defined in [mlabs/src/Mlabs/Lending/Contract/Api.hs](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/src/Mlabs/Lending/Contract/Api.hs#L146) + +### Lendex: APIs & Endpoints + +- User Actions + + - Deposit + - [x] in use. + - Description: *Deposit funds to app.* + + - Borrow + - [x] in use. + - Description: *Borrow funds by depositing a collateral.* + + - Repay + - [x] in use. + - Description: *Repay part of a Loan.* + + - SwapBorrowRateModel + - [x] in use. + - Description: *Swap borrow interest rate strategy (stable to variable).* + + - SetUserReserveAsCollateral + - [x] in use. + - Description: *Set some portion of deposit as collateral or some portion of collateral as deposit.* + + - Withdraw + - [x] in use. + - Description: *Withdraw funds from deposit.* + + - LiquidationCall + - [x] in use. + - Description: *Call to liquidate borrows that are unsafe due to health check. For further see [docs.aave.com/faq/liquidations](https://docs.aave.com/faq/liquidations)* + +- Admin actions + + - AddReserve + - [x] in use. + - Description: *Adds a new reserve.* + + - StartParams + - [x] in use. + - Description: *Sets the start parameters for the Lendex*. + +### Lendex: Tests + +- To run the tests: + +```bash +stack test all +``` + +- To see test cases refer to: `./test/Test/Lending` + +### Lendex: Notes + +-------------------------------------------------------------------------------- + +## Use Case: NFT + +### NFT: Description + +The core functionality of the Non Fungible Tokens(i.e. NFTs) Use Case revolves +around minting, sending, receiving NFTs into a Cardano wallet. + +NFTs are a digital asset that represents real-world objects. They can be bought +and sold online, and act as a proof of ownership for the underlying asset they +are meant to represent. Fungibility is the property of an asset to be +interchangeable with its equal value in another fungible asset (example: $1 and +10x $0.10 are interchangeable). Given that real-world objects cannot be replaced +as easily with equivalent objects is a propert reflected in the nature of NFTs. + +For more details on NFT's refer to: + +- [Forbes: What You Need To Know About NFT's](https://www.forbes.com/advisor/investing/nft-non-fungible-token/) +- [Cambridge Dictionary: nonfungible](https://dictionary.cambridge.org/us/dictionary/english/nonfungible) + +### NFT: Progress & Planning + +- Goals and status: + - Development *TODO: add some achieved/ future goals* + - [x] Feature Completeness as per Specifications + - [ ] Improve Deployment Story + - [ ] Improve Performance + - [ ] Improve Ergonomics of Use and Installation + + - Testing + - [x] 100% Test Coverage + - [ ] QuickCheck Testing + + - Documentation + - [x] Example + - [ ] APIs + +### NFT: Examples + +- [NFT Demo](https://github.com/mlabs-haskell/plutus-use-cases/blob/main/mlabs/nft-demo/Main.hs) + +### NFT: APIs & Endpoints + +- User Endpoints: + - Buy + - [x] in use. + - Description: *User buys NFT.* + - SetPrice + - [x] in use. + - Description: *User sets new price for NFT.* + +- Author Endpoints: + - StartParams + - [x] in use. + - Description: *Sets the parameters to initialise a new NFT.* + +- User Schemas: + - UserSchema + - [x] in use. + - Description: *User schema. Owner can set the price and the buyer can try to buy.* + - AuthorSchema + - [x] in use. + - Description: *Schema for the author of NFT*. + +### NFT: Tests + +- To run the tests: + +```bash +stack test all +``` + +- To see test cases refer to: `./test/Test/Nft` + +### NFT: Notes + +*TODO: Add any relevant notes* + diff --git a/mlabs/demo-frontend/package-lock.json b/mlabs/demo-frontend/package-lock.json new file mode 100644 index 000000000..52add8998 --- /dev/null +++ b/mlabs/demo-frontend/package-lock.json @@ -0,0 +1,9494 @@ +{ + "requires": true, + "lockfileVersion": 1, + "dependencies": { + "@babel/code-frame": { + "version": "7.0.0", + "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.0.0.tgz", + "integrity": "sha512-OfC2uemaknXr87bdLUkWog7nYuliM9Ij5HUcajsVcMCpQrcLmtxRbVFTIqmcSkSeYRBFBRxs2FiUqFJDLdiebA==", + "requires": { + "@babel/highlight": "^7.0.0" + } + }, + "@babel/compat-data": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/compat-data/-/compat-data-7.14.7.tgz", + "integrity": "sha512-nS6dZaISCXJ3+518CWiBfEr//gHyMO02uDxBkXTKZDN5POruCnOZ1N4YBRZDCabwF8nZMWBpRxIicmXtBs+fvw==" + }, + "@babel/core": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/core/-/core-7.3.4.tgz", + "integrity": "sha512-jRsuseXBo9pN197KnDwhhaaBzyZr2oIcLHHTt2oDdQrej5Qp57dCCJafWx5ivU8/alEYDpssYqv1MUqcxwQlrA==", + "requires": { + "@babel/code-frame": "^7.0.0", + "@babel/generator": "^7.3.4", + "@babel/helpers": "^7.2.0", + "@babel/parser": "^7.3.4", + "@babel/template": "^7.2.2", + "@babel/traverse": "^7.3.4", + "@babel/types": "^7.3.4", + "convert-source-map": "^1.1.0", + "debug": "^4.1.0", + "json5": "^2.1.0", + "lodash": "^4.17.11", + "resolve": "^1.3.2", + "semver": "^5.4.1", + "source-map": "^0.5.0" + }, + "dependencies": { + "json5": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/json5/-/json5-2.2.0.tgz", + "integrity": "sha512-f+8cldu7X/y7RAJurMEJmdoKXGB/X550w2Nr3tTbezL6RwEE/iMcm+tZnXeoZtKuOq6ft8+CqzEkrIgx1fPoQA==", + "requires": { + "minimist": "^1.2.5" + } + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "@babel/generator": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/generator/-/generator-7.3.4.tgz", + "integrity": "sha512-8EXhHRFqlVVWXPezBW5keTiQi/rJMQTg/Y9uVCEZ0CAF3PKtCCaVRnp64Ii1ujhkoDhhF1fVsImoN4yJ2uz4Wg==", + "requires": { + "@babel/types": "^7.3.4", + "jsesc": "^2.5.1", + "lodash": "^4.17.11", + "source-map": "^0.5.0", + "trim-right": "^1.0.1" + }, + "dependencies": { + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "@babel/helper-annotate-as-pure": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-annotate-as-pure/-/helper-annotate-as-pure-7.14.5.tgz", + "integrity": "sha512-EivH9EgBIb+G8ij1B2jAwSH36WnGvkQSEC6CkX/6v6ZFlw5fVOHvsgGF4uiEHO2GzMvunZb6tDLQEQSdrdocrA==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-builder-binary-assignment-operator-visitor": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-builder-binary-assignment-operator-visitor/-/helper-builder-binary-assignment-operator-visitor-7.14.5.tgz", + "integrity": "sha512-YTA/Twn0vBXDVGJuAX6PwW7x5zQei1luDDo2Pl6q1qZ7hVNl0RZrhHCQG/ArGpR29Vl7ETiB8eJyrvpuRp300w==", + "requires": { + "@babel/helper-explode-assignable-expression": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-builder-react-jsx": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-builder-react-jsx/-/helper-builder-react-jsx-7.14.5.tgz", + "integrity": "sha512-LT/856RUBXAHjmvJuLuI6XYZZAZNMSS+N2Yf5EUoHgSWtiWrAaGh7t5saP7sPCq07uvWVxxK3gwwm3weA9gKLg==", + "requires": { + "@babel/helper-annotate-as-pure": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-compilation-targets": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-compilation-targets/-/helper-compilation-targets-7.14.5.tgz", + "integrity": "sha512-v+QtZqXEiOnpO6EYvlImB6zCD2Lel06RzOPzmkz/D/XgQiUu3C/Jb1LOqSt/AIA34TYi/Q+KlT8vTQrgdxkbLw==", + "requires": { + "@babel/compat-data": "^7.14.5", + "@babel/helper-validator-option": "^7.14.5", + "browserslist": "^4.16.6", + "semver": "^6.3.0" + }, + "dependencies": { + "semver": { + "version": "6.3.0", + "resolved": "https://registry.npmjs.org/semver/-/semver-6.3.0.tgz", + "integrity": "sha512-b39TBaTSfV6yBrapU89p5fKekE2m/NwnDocOVruQFS1/veMgdzuPcnOM34M6CwxW8jH/lxEa5rBoDeUwu5HHTw==" + } + } + }, + "@babel/helper-create-regexp-features-plugin": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-create-regexp-features-plugin/-/helper-create-regexp-features-plugin-7.14.5.tgz", + "integrity": "sha512-TLawwqpOErY2HhWbGJ2nZT5wSkR192QpN+nBg1THfBfftrlvOh+WbhrxXCH4q4xJ9Gl16BGPR/48JA+Ryiho/A==", + "requires": { + "@babel/helper-annotate-as-pure": "^7.14.5", + "regexpu-core": "^4.7.1" + } + }, + "@babel/helper-explode-assignable-expression": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-explode-assignable-expression/-/helper-explode-assignable-expression-7.14.5.tgz", + "integrity": "sha512-Htb24gnGJdIGT4vnRKMdoXiOIlqOLmdiUYpAQ0mYfgVT/GDm8GOYhgi4GL+hMKrkiPRohO4ts34ELFsGAPQLDQ==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-function-name": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-function-name/-/helper-function-name-7.14.5.tgz", + "integrity": "sha512-Gjna0AsXWfFvrAuX+VKcN/aNNWonizBj39yGwUzVDVTlMYJMK2Wp6xdpy72mfArFq5uK+NOuexfzZlzI1z9+AQ==", + "requires": { + "@babel/helper-get-function-arity": "^7.14.5", + "@babel/template": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/code-frame": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.14.5.tgz", + "integrity": "sha512-9pzDqyc6OLDaqe+zbACgFkb6fKMNG6CObKpnYXChRsvYGyEdc7CA2BaqeOM+vOtCS5ndmJicPJhKAwYRI6UfFw==", + "requires": { + "@babel/highlight": "^7.14.5" + } + }, + "@babel/parser": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/parser/-/parser-7.14.7.tgz", + "integrity": "sha512-X67Z5y+VBJuHB/RjwECp8kSl5uYi0BvRbNeWqkaJCVh+LiTPl19WBUfG627psSgp9rSf6ojuXghQM3ha6qHHdA==" + }, + "@babel/template": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/template/-/template-7.14.5.tgz", + "integrity": "sha512-6Z3Po85sfxRGachLULUhOmvAaOo7xCvqGQtxINai2mEGPFm6pQ4z5QInFnUrRpfoSV60BnjyF5F3c+15fxFV1g==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/parser": "^7.14.5", + "@babel/types": "^7.14.5" + } + }, + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-get-function-arity": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-get-function-arity/-/helper-get-function-arity-7.14.5.tgz", + "integrity": "sha512-I1Db4Shst5lewOM4V+ZKJzQ0JGGaZ6VY1jYvMghRjqs6DWgxLCIyFt30GlnKkfUeFLpJt2vzbMVEXVSXlIFYUg==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-hoist-variables": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-hoist-variables/-/helper-hoist-variables-7.14.5.tgz", + "integrity": "sha512-R1PXiz31Uc0Vxy4OEOm07x0oSjKAdPPCh3tPivn/Eo8cvz6gveAeuyUUPB21Hoiif0uoPQSSdhIPS3352nvdyQ==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-member-expression-to-functions": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/helper-member-expression-to-functions/-/helper-member-expression-to-functions-7.14.7.tgz", + "integrity": "sha512-TMUt4xKxJn6ccjcOW7c4hlwyJArizskAhoSTOCkA0uZ+KghIaci0Qg9R043kUMWI9mtQfgny+NQ5QATnZ+paaA==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-module-imports": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-module-imports/-/helper-module-imports-7.14.5.tgz", + "integrity": "sha512-SwrNHu5QWS84XlHwGYPDtCxcA0hrSlL2yhWYLgeOc0w7ccOl2qv4s/nARI0aYZW+bSwAL5CukeXA47B/1NKcnQ==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-module-transforms": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-module-transforms/-/helper-module-transforms-7.14.5.tgz", + "integrity": "sha512-iXpX4KW8LVODuAieD7MzhNjmM6dzYY5tfRqT+R9HDXWl0jPn/djKmA+G9s/2C2T9zggw5tK1QNqZ70USfedOwA==", + "requires": { + "@babel/helper-module-imports": "^7.14.5", + "@babel/helper-replace-supers": "^7.14.5", + "@babel/helper-simple-access": "^7.14.5", + "@babel/helper-split-export-declaration": "^7.14.5", + "@babel/helper-validator-identifier": "^7.14.5", + "@babel/template": "^7.14.5", + "@babel/traverse": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/code-frame": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.14.5.tgz", + "integrity": "sha512-9pzDqyc6OLDaqe+zbACgFkb6fKMNG6CObKpnYXChRsvYGyEdc7CA2BaqeOM+vOtCS5ndmJicPJhKAwYRI6UfFw==", + "requires": { + "@babel/highlight": "^7.14.5" + } + }, + "@babel/generator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/generator/-/generator-7.14.5.tgz", + "integrity": "sha512-y3rlP+/G25OIX3mYKKIOlQRcqj7YgrvHxOLbVmyLJ9bPmi5ttvUmpydVjcFjZphOktWuA7ovbx91ECloWTfjIA==", + "requires": { + "@babel/types": "^7.14.5", + "jsesc": "^2.5.1", + "source-map": "^0.5.0" + } + }, + "@babel/parser": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/parser/-/parser-7.14.7.tgz", + "integrity": "sha512-X67Z5y+VBJuHB/RjwECp8kSl5uYi0BvRbNeWqkaJCVh+LiTPl19WBUfG627psSgp9rSf6ojuXghQM3ha6qHHdA==" + }, + "@babel/template": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/template/-/template-7.14.5.tgz", + "integrity": "sha512-6Z3Po85sfxRGachLULUhOmvAaOo7xCvqGQtxINai2mEGPFm6pQ4z5QInFnUrRpfoSV60BnjyF5F3c+15fxFV1g==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/parser": "^7.14.5", + "@babel/types": "^7.14.5" + } + }, + "@babel/traverse": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/traverse/-/traverse-7.14.7.tgz", + "integrity": "sha512-9vDr5NzHu27wgwejuKL7kIOm4bwEtaPQ4Z6cpCmjSuaRqpH/7xc4qcGEscwMqlkwgcXl6MvqoAjZkQ24uSdIZQ==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/generator": "^7.14.5", + "@babel/helper-function-name": "^7.14.5", + "@babel/helper-hoist-variables": "^7.14.5", + "@babel/helper-split-export-declaration": "^7.14.5", + "@babel/parser": "^7.14.7", + "@babel/types": "^7.14.5", + "debug": "^4.1.0", + "globals": "^11.1.0" + } + }, + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "@babel/helper-optimise-call-expression": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-optimise-call-expression/-/helper-optimise-call-expression-7.14.5.tgz", + "integrity": "sha512-IqiLIrODUOdnPU9/F8ib1Fx2ohlgDhxnIDU7OEVi+kAbEZcyiF7BLU8W6PfvPi9LzztjS7kcbzbmL7oG8kD6VA==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-plugin-utils": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-plugin-utils/-/helper-plugin-utils-7.14.5.tgz", + "integrity": "sha512-/37qQCE3K0vvZKwoK4XU/irIJQdIfCJuhU5eKnNxpFDsOkgFaUAwbv+RYw6eYgsC0E4hS7r5KqGULUogqui0fQ==" + }, + "@babel/helper-remap-async-to-generator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-remap-async-to-generator/-/helper-remap-async-to-generator-7.14.5.tgz", + "integrity": "sha512-rLQKdQU+HYlxBwQIj8dk4/0ENOUEhA/Z0l4hN8BexpvmSMN9oA9EagjnhnDpNsRdWCfjwa4mn/HyBXO9yhQP6A==", + "requires": { + "@babel/helper-annotate-as-pure": "^7.14.5", + "@babel/helper-wrap-function": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-replace-supers": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-replace-supers/-/helper-replace-supers-7.14.5.tgz", + "integrity": "sha512-3i1Qe9/8x/hCHINujn+iuHy+mMRLoc77b2nI9TB0zjH1hvn9qGlXjWlggdwUcju36PkPCy/lpM7LLUdcTyH4Ow==", + "requires": { + "@babel/helper-member-expression-to-functions": "^7.14.5", + "@babel/helper-optimise-call-expression": "^7.14.5", + "@babel/traverse": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/code-frame": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.14.5.tgz", + "integrity": "sha512-9pzDqyc6OLDaqe+zbACgFkb6fKMNG6CObKpnYXChRsvYGyEdc7CA2BaqeOM+vOtCS5ndmJicPJhKAwYRI6UfFw==", + "requires": { + "@babel/highlight": "^7.14.5" + } + }, + "@babel/generator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/generator/-/generator-7.14.5.tgz", + "integrity": "sha512-y3rlP+/G25OIX3mYKKIOlQRcqj7YgrvHxOLbVmyLJ9bPmi5ttvUmpydVjcFjZphOktWuA7ovbx91ECloWTfjIA==", + "requires": { + "@babel/types": "^7.14.5", + "jsesc": "^2.5.1", + "source-map": "^0.5.0" + } + }, + "@babel/parser": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/parser/-/parser-7.14.7.tgz", + "integrity": "sha512-X67Z5y+VBJuHB/RjwECp8kSl5uYi0BvRbNeWqkaJCVh+LiTPl19WBUfG627psSgp9rSf6ojuXghQM3ha6qHHdA==" + }, + "@babel/traverse": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/traverse/-/traverse-7.14.7.tgz", + "integrity": "sha512-9vDr5NzHu27wgwejuKL7kIOm4bwEtaPQ4Z6cpCmjSuaRqpH/7xc4qcGEscwMqlkwgcXl6MvqoAjZkQ24uSdIZQ==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/generator": "^7.14.5", + "@babel/helper-function-name": "^7.14.5", + "@babel/helper-hoist-variables": "^7.14.5", + "@babel/helper-split-export-declaration": "^7.14.5", + "@babel/parser": "^7.14.7", + "@babel/types": "^7.14.5", + "debug": "^4.1.0", + "globals": "^11.1.0" + } + }, + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "@babel/helper-simple-access": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-simple-access/-/helper-simple-access-7.14.5.tgz", + "integrity": "sha512-nfBN9xvmCt6nrMZjfhkl7i0oTV3yxR4/FztsbOASyTvVcoYd0TRHh7eMLdlEcCqobydC0LAF3LtC92Iwxo0wyw==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-skip-transparent-expression-wrappers": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-skip-transparent-expression-wrappers/-/helper-skip-transparent-expression-wrappers-7.14.5.tgz", + "integrity": "sha512-dmqZB7mrb94PZSAOYtr+ZN5qt5owZIAgqtoTuqiFbHFtxgEcmQlRJVI+bO++fciBunXtB6MK7HrzrfcAzIz2NQ==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-split-export-declaration": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-split-export-declaration/-/helper-split-export-declaration-7.14.5.tgz", + "integrity": "sha512-hprxVPu6e5Kdp2puZUmvOGjaLv9TCe58E/Fl6hRq4YiVQxIcNvuq6uTM2r1mT/oPskuS9CgR+I94sqAYv0NGKA==", + "requires": { + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + } + } + }, + "@babel/helper-validator-identifier": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-validator-identifier/-/helper-validator-identifier-7.14.5.tgz", + "integrity": "sha512-5lsetuxCLilmVGyiLEfoHBRX8UCFD+1m2x3Rj97WrW3V7H3u4RWRXA4evMjImCsin2J2YT0QaVDGf+z8ondbAg==" + }, + "@babel/helper-validator-option": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-validator-option/-/helper-validator-option-7.14.5.tgz", + "integrity": "sha512-OX8D5eeX4XwcroVW45NMvoYaIuFI+GQpA2a8Gi+X/U/cDUIRsV37qQfF905F0htTRCREQIB4KqPeaveRJUl3Ow==" + }, + "@babel/helper-wrap-function": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/helper-wrap-function/-/helper-wrap-function-7.14.5.tgz", + "integrity": "sha512-YEdjTCq+LNuNS1WfxsDCNpgXkJaIyqco6DAelTUjT4f2KIWC1nBcaCaSdHTBqQVLnTBexBcVcFhLSU1KnYuePQ==", + "requires": { + "@babel/helper-function-name": "^7.14.5", + "@babel/template": "^7.14.5", + "@babel/traverse": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/code-frame": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.14.5.tgz", + "integrity": "sha512-9pzDqyc6OLDaqe+zbACgFkb6fKMNG6CObKpnYXChRsvYGyEdc7CA2BaqeOM+vOtCS5ndmJicPJhKAwYRI6UfFw==", + "requires": { + "@babel/highlight": "^7.14.5" + } + }, + "@babel/generator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/generator/-/generator-7.14.5.tgz", + "integrity": "sha512-y3rlP+/G25OIX3mYKKIOlQRcqj7YgrvHxOLbVmyLJ9bPmi5ttvUmpydVjcFjZphOktWuA7ovbx91ECloWTfjIA==", + "requires": { + "@babel/types": "^7.14.5", + "jsesc": "^2.5.1", + "source-map": "^0.5.0" + } + }, + "@babel/parser": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/parser/-/parser-7.14.7.tgz", + "integrity": "sha512-X67Z5y+VBJuHB/RjwECp8kSl5uYi0BvRbNeWqkaJCVh+LiTPl19WBUfG627psSgp9rSf6ojuXghQM3ha6qHHdA==" + }, + "@babel/template": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/template/-/template-7.14.5.tgz", + "integrity": "sha512-6Z3Po85sfxRGachLULUhOmvAaOo7xCvqGQtxINai2mEGPFm6pQ4z5QInFnUrRpfoSV60BnjyF5F3c+15fxFV1g==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/parser": "^7.14.5", + "@babel/types": "^7.14.5" + } + }, + "@babel/traverse": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/traverse/-/traverse-7.14.7.tgz", + "integrity": "sha512-9vDr5NzHu27wgwejuKL7kIOm4bwEtaPQ4Z6cpCmjSuaRqpH/7xc4qcGEscwMqlkwgcXl6MvqoAjZkQ24uSdIZQ==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/generator": "^7.14.5", + "@babel/helper-function-name": "^7.14.5", + "@babel/helper-hoist-variables": "^7.14.5", + "@babel/helper-split-export-declaration": "^7.14.5", + "@babel/parser": "^7.14.7", + "@babel/types": "^7.14.5", + "debug": "^4.1.0", + "globals": "^11.1.0" + } + }, + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "@babel/helpers": { + "version": "7.14.6", + "resolved": "https://registry.npmjs.org/@babel/helpers/-/helpers-7.14.6.tgz", + "integrity": "sha512-yesp1ENQBiLI+iYHSJdoZKUtRpfTlL1grDIX9NRlAVppljLw/4tTyYupIB7uIYmC3stW/imAv8EqaKaS/ibmeA==", + "requires": { + "@babel/template": "^7.14.5", + "@babel/traverse": "^7.14.5", + "@babel/types": "^7.14.5" + }, + "dependencies": { + "@babel/code-frame": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/code-frame/-/code-frame-7.14.5.tgz", + "integrity": "sha512-9pzDqyc6OLDaqe+zbACgFkb6fKMNG6CObKpnYXChRsvYGyEdc7CA2BaqeOM+vOtCS5ndmJicPJhKAwYRI6UfFw==", + "requires": { + "@babel/highlight": "^7.14.5" + } + }, + "@babel/generator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/generator/-/generator-7.14.5.tgz", + "integrity": "sha512-y3rlP+/G25OIX3mYKKIOlQRcqj7YgrvHxOLbVmyLJ9bPmi5ttvUmpydVjcFjZphOktWuA7ovbx91ECloWTfjIA==", + "requires": { + "@babel/types": "^7.14.5", + "jsesc": "^2.5.1", + "source-map": "^0.5.0" + } + }, + "@babel/parser": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/parser/-/parser-7.14.7.tgz", + "integrity": "sha512-X67Z5y+VBJuHB/RjwECp8kSl5uYi0BvRbNeWqkaJCVh+LiTPl19WBUfG627psSgp9rSf6ojuXghQM3ha6qHHdA==" + }, + "@babel/template": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/template/-/template-7.14.5.tgz", + "integrity": "sha512-6Z3Po85sfxRGachLULUhOmvAaOo7xCvqGQtxINai2mEGPFm6pQ4z5QInFnUrRpfoSV60BnjyF5F3c+15fxFV1g==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/parser": "^7.14.5", + "@babel/types": "^7.14.5" + } + }, + "@babel/traverse": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/traverse/-/traverse-7.14.7.tgz", + "integrity": "sha512-9vDr5NzHu27wgwejuKL7kIOm4bwEtaPQ4Z6cpCmjSuaRqpH/7xc4qcGEscwMqlkwgcXl6MvqoAjZkQ24uSdIZQ==", + "requires": { + "@babel/code-frame": "^7.14.5", + "@babel/generator": "^7.14.5", + "@babel/helper-function-name": "^7.14.5", + "@babel/helper-hoist-variables": "^7.14.5", + "@babel/helper-split-export-declaration": "^7.14.5", + "@babel/parser": "^7.14.7", + "@babel/types": "^7.14.5", + "debug": "^4.1.0", + "globals": "^11.1.0" + } + }, + "@babel/types": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.14.5.tgz", + "integrity": "sha512-M/NzBpEL95I5Hh4dwhin5JlE7EzO5PHMAuzjxss3tiOBD46KfQvVedN/3jEPZvdRvtsK2222XfdHogNIttFgcg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "to-fast-properties": "^2.0.0" + } + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "@babel/highlight": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/highlight/-/highlight-7.14.5.tgz", + "integrity": "sha512-qf9u2WFWVV0MppaL877j2dBtQIDgmidgjGk5VIMw3OadXvYaXn66U1BFlH2t4+t3i+8PhedppRv+i40ABzd+gg==", + "requires": { + "@babel/helper-validator-identifier": "^7.14.5", + "chalk": "^2.0.0", + "js-tokens": "^4.0.0" + } + }, + "@babel/parser": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/parser/-/parser-7.3.4.tgz", + "integrity": "sha512-tXZCqWtlOOP4wgCp6RjRvLmfuhnqTLy9VHwRochJBCP2nDm27JnnuFEnXFASVyQNHk36jD1tAammsCEEqgscIQ==" + }, + "@babel/plugin-proposal-async-generator-functions": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/plugin-proposal-async-generator-functions/-/plugin-proposal-async-generator-functions-7.14.7.tgz", + "integrity": "sha512-RK8Wj7lXLY3bqei69/cc25gwS5puEc3dknoFPFbqfy3XxYQBQFvu4ioWpafMBAB+L9NyptQK4nMOa5Xz16og8Q==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/helper-remap-async-to-generator": "^7.14.5", + "@babel/plugin-syntax-async-generators": "^7.8.4" + } + }, + "@babel/plugin-proposal-json-strings": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-proposal-json-strings/-/plugin-proposal-json-strings-7.14.5.tgz", + "integrity": "sha512-NSq2fczJYKVRIsUJyNxrVUMhB27zb7N7pOFGQOhBKJrChbGcgEAqyZrmZswkPk18VMurEeJAaICbfm57vUeTbQ==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/plugin-syntax-json-strings": "^7.8.3" + } + }, + "@babel/plugin-proposal-object-rest-spread": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/plugin-proposal-object-rest-spread/-/plugin-proposal-object-rest-spread-7.14.7.tgz", + "integrity": "sha512-082hsZz+sVabfmDWo1Oct1u1AgbKbUAyVgmX4otIc7bdsRgHBXwTwb3DpDmD4Eyyx6DNiuz5UAATT655k+kL5g==", + "requires": { + "@babel/compat-data": "^7.14.7", + "@babel/helper-compilation-targets": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/plugin-syntax-object-rest-spread": "^7.8.3", + "@babel/plugin-transform-parameters": "^7.14.5" + } + }, + "@babel/plugin-proposal-optional-catch-binding": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-proposal-optional-catch-binding/-/plugin-proposal-optional-catch-binding-7.14.5.tgz", + "integrity": "sha512-3Oyiixm0ur7bzO5ybNcZFlmVsygSIQgdOa7cTfOYCMY+wEPAYhZAJxi3mixKFCTCKUhQXuCTtQ1MzrpL3WT8ZQ==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/plugin-syntax-optional-catch-binding": "^7.8.3" + } + }, + "@babel/plugin-proposal-unicode-property-regex": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-proposal-unicode-property-regex/-/plugin-proposal-unicode-property-regex-7.14.5.tgz", + "integrity": "sha512-6axIeOU5LnY471KenAB9vI8I5j7NQ2d652hIYwVyRfgaZT5UpiqFKCuVXCDMSrU+3VFafnu2c5m3lrWIlr6A5Q==", + "requires": { + "@babel/helper-create-regexp-features-plugin": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-syntax-async-generators": { + "version": "7.8.4", + "resolved": "https://registry.npmjs.org/@babel/plugin-syntax-async-generators/-/plugin-syntax-async-generators-7.8.4.tgz", + "integrity": "sha512-tycmZxkGfZaxhMRbXlPXuVFpdWlXpir2W4AMhSJgRKzk/eDlIXOhb2LHWoLpDF7TEHylV5zNhykX6KAgHJmTNw==", + "requires": { + "@babel/helper-plugin-utils": "^7.8.0" + } + }, + "@babel/plugin-syntax-flow": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-syntax-flow/-/plugin-syntax-flow-7.14.5.tgz", + "integrity": "sha512-9WK5ZwKCdWHxVuU13XNT6X73FGmutAXeor5lGFq6qhOFtMFUF4jkbijuyUdZZlpYq6E2hZeZf/u3959X9wsv0Q==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-syntax-json-strings": { + "version": "7.8.3", + "resolved": "https://registry.npmjs.org/@babel/plugin-syntax-json-strings/-/plugin-syntax-json-strings-7.8.3.tgz", + "integrity": "sha512-lY6kdGpWHvjoe2vk4WrAapEuBR69EMxZl+RoGRhrFGNYVK8mOPAW8VfbT/ZgrFbXlDNiiaxQnAtgVCZ6jv30EA==", + "requires": { + "@babel/helper-plugin-utils": "^7.8.0" + } + }, + "@babel/plugin-syntax-jsx": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-syntax-jsx/-/plugin-syntax-jsx-7.14.5.tgz", + "integrity": "sha512-ohuFIsOMXJnbOMRfX7/w7LocdR6R7whhuRD4ax8IipLcLPlZGJKkBxgHp++U4N/vKyU16/YDQr2f5seajD3jIw==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-syntax-object-rest-spread": { + "version": "7.8.3", + "resolved": "https://registry.npmjs.org/@babel/plugin-syntax-object-rest-spread/-/plugin-syntax-object-rest-spread-7.8.3.tgz", + "integrity": "sha512-XoqMijGZb9y3y2XskN+P1wUGiVwWZ5JmoDRwx5+3GmEplNyVM2s2Dg8ILFQm8rWM48orGy5YpI5Bl8U1y7ydlA==", + "requires": { + "@babel/helper-plugin-utils": "^7.8.0" + } + }, + "@babel/plugin-syntax-optional-catch-binding": { + "version": "7.8.3", + "resolved": "https://registry.npmjs.org/@babel/plugin-syntax-optional-catch-binding/-/plugin-syntax-optional-catch-binding-7.8.3.tgz", + "integrity": "sha512-6VPD0Pc1lpTqw0aKoeRTMiB+kWhAoT24PA+ksWSBrFtl5SIRVpZlwN3NNPQjehA2E/91FV3RjLWoVTglWcSV3Q==", + "requires": { + "@babel/helper-plugin-utils": "^7.8.0" + } + }, + "@babel/plugin-transform-arrow-functions": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-arrow-functions/-/plugin-transform-arrow-functions-7.14.5.tgz", + "integrity": "sha512-KOnO0l4+tD5IfOdi4x8C1XmEIRWUjNRV8wc6K2vz/3e8yAOoZZvsRXRRIF/yo/MAOFb4QjtAw9xSxMXbSMRy8A==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-async-to-generator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-async-to-generator/-/plugin-transform-async-to-generator-7.14.5.tgz", + "integrity": "sha512-szkbzQ0mNk0rpu76fzDdqSyPu0MuvpXgC+6rz5rpMb5OIRxdmHfQxrktL8CYolL2d8luMCZTR0DpIMIdL27IjA==", + "requires": { + "@babel/helper-module-imports": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/helper-remap-async-to-generator": "^7.14.5" + } + }, + "@babel/plugin-transform-block-scoped-functions": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-block-scoped-functions/-/plugin-transform-block-scoped-functions-7.14.5.tgz", + "integrity": "sha512-dtqWqdWZ5NqBX3KzsVCWfQI3A53Ft5pWFCT2eCVUftWZgjc5DpDponbIF1+c+7cSGk2wN0YK7HGL/ezfRbpKBQ==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-block-scoping": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-block-scoping/-/plugin-transform-block-scoping-7.14.5.tgz", + "integrity": "sha512-LBYm4ZocNgoCqyxMLoOnwpsmQ18HWTQvql64t3GvMUzLQrNoV1BDG0lNftC8QKYERkZgCCT/7J5xWGObGAyHDw==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-classes": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-classes/-/plugin-transform-classes-7.14.5.tgz", + "integrity": "sha512-J4VxKAMykM06K/64z9rwiL6xnBHgB1+FVspqvlgCdwD1KUbQNfszeKVVOMh59w3sztHYIZDgnhOC4WbdEfHFDA==", + "requires": { + "@babel/helper-annotate-as-pure": "^7.14.5", + "@babel/helper-function-name": "^7.14.5", + "@babel/helper-optimise-call-expression": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/helper-replace-supers": "^7.14.5", + "@babel/helper-split-export-declaration": "^7.14.5", + "globals": "^11.1.0" + } + }, + "@babel/plugin-transform-computed-properties": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-computed-properties/-/plugin-transform-computed-properties-7.14.5.tgz", + "integrity": "sha512-pWM+E4283UxaVzLb8UBXv4EIxMovU4zxT1OPnpHJcmnvyY9QbPPTKZfEj31EUvG3/EQRbYAGaYEUZ4yWOBC2xg==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-destructuring": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-destructuring/-/plugin-transform-destructuring-7.14.7.tgz", + "integrity": "sha512-0mDE99nK+kVh3xlc5vKwB6wnP9ecuSj+zQCa/n0voENtP/zymdT4HH6QEb65wjjcbqr1Jb/7z9Qp7TF5FtwYGw==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-dotall-regex": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-dotall-regex/-/plugin-transform-dotall-regex-7.14.5.tgz", + "integrity": "sha512-loGlnBdj02MDsFaHhAIJzh7euK89lBrGIdM9EAtHFo6xKygCUGuuWe07o1oZVk287amtW1n0808sQM99aZt3gw==", + "requires": { + "@babel/helper-create-regexp-features-plugin": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-duplicate-keys": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-duplicate-keys/-/plugin-transform-duplicate-keys-7.14.5.tgz", + "integrity": "sha512-iJjbI53huKbPDAsJ8EmVmvCKeeq21bAze4fu9GBQtSLqfvzj2oRuHVx4ZkDwEhg1htQ+5OBZh/Ab0XDf5iBZ7A==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-exponentiation-operator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-exponentiation-operator/-/plugin-transform-exponentiation-operator-7.14.5.tgz", + "integrity": "sha512-jFazJhMBc9D27o9jDnIE5ZErI0R0m7PbKXVq77FFvqFbzvTMuv8jaAwLZ5PviOLSFttqKIW0/wxNSDbjLk0tYA==", + "requires": { + "@babel/helper-builder-binary-assignment-operator-visitor": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-flow-strip-types": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-flow-strip-types/-/plugin-transform-flow-strip-types-7.3.4.tgz", + "integrity": "sha512-PmQC9R7DwpBFA+7ATKMyzViz3zCaMNouzZMPZN2K5PnbBbtL3AXFYTkDk+Hey5crQq2A90UG5Uthz0mel+XZrA==", + "requires": { + "@babel/helper-plugin-utils": "^7.0.0", + "@babel/plugin-syntax-flow": "^7.2.0" + } + }, + "@babel/plugin-transform-for-of": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-for-of/-/plugin-transform-for-of-7.14.5.tgz", + "integrity": "sha512-CfmqxSUZzBl0rSjpoQSFoR9UEj3HzbGuGNL21/iFTmjb5gFggJp3ph0xR1YBhexmLoKRHzgxuFvty2xdSt6gTA==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-function-name": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-function-name/-/plugin-transform-function-name-7.14.5.tgz", + "integrity": "sha512-vbO6kv0fIzZ1GpmGQuvbwwm+O4Cbm2NrPzwlup9+/3fdkuzo1YqOZcXw26+YUJB84Ja7j9yURWposEHLYwxUfQ==", + "requires": { + "@babel/helper-function-name": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-literals": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-literals/-/plugin-transform-literals-7.14.5.tgz", + "integrity": "sha512-ql33+epql2F49bi8aHXxvLURHkxJbSmMKl9J5yHqg4PLtdE6Uc48CH1GS6TQvZ86eoB/ApZXwm7jlA+B3kra7A==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-modules-amd": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-modules-amd/-/plugin-transform-modules-amd-7.14.5.tgz", + "integrity": "sha512-3lpOU8Vxmp3roC4vzFpSdEpGUWSMsHFreTWOMMLzel2gNGfHE5UWIh/LN6ghHs2xurUp4jRFYMUIZhuFbody1g==", + "requires": { + "@babel/helper-module-transforms": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5", + "babel-plugin-dynamic-import-node": "^2.3.3" + } + }, + "@babel/plugin-transform-modules-commonjs": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-modules-commonjs/-/plugin-transform-modules-commonjs-7.2.0.tgz", + "integrity": "sha512-V6y0uaUQrQPXUrmj+hgnks8va2L0zcZymeU7TtWEgdRLNkceafKXEduv7QzgQAE4lT+suwooG9dC7LFhdRAbVQ==", + "requires": { + "@babel/helper-module-transforms": "^7.1.0", + "@babel/helper-plugin-utils": "^7.0.0", + "@babel/helper-simple-access": "^7.1.0" + } + }, + "@babel/plugin-transform-modules-systemjs": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-modules-systemjs/-/plugin-transform-modules-systemjs-7.14.5.tgz", + "integrity": "sha512-mNMQdvBEE5DcMQaL5LbzXFMANrQjd2W7FPzg34Y4yEz7dBgdaC+9B84dSO+/1Wba98zoDbInctCDo4JGxz1VYA==", + "requires": { + "@babel/helper-hoist-variables": "^7.14.5", + "@babel/helper-module-transforms": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/helper-validator-identifier": "^7.14.5", + "babel-plugin-dynamic-import-node": "^2.3.3" + } + }, + "@babel/plugin-transform-modules-umd": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-modules-umd/-/plugin-transform-modules-umd-7.14.5.tgz", + "integrity": "sha512-RfPGoagSngC06LsGUYyM9QWSXZ8MysEjDJTAea1lqRjNECE3y0qIJF/qbvJxc4oA4s99HumIMdXOrd+TdKaAAA==", + "requires": { + "@babel/helper-module-transforms": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-named-capturing-groups-regex": { + "version": "7.14.7", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-named-capturing-groups-regex/-/plugin-transform-named-capturing-groups-regex-7.14.7.tgz", + "integrity": "sha512-DTNOTaS7TkW97xsDMrp7nycUVh6sn/eq22VaxWfEdzuEbRsiaOU0pqU7DlyUGHVsbQbSghvjKRpEl+nUCKGQSg==", + "requires": { + "@babel/helper-create-regexp-features-plugin": "^7.14.5" + } + }, + "@babel/plugin-transform-new-target": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-new-target/-/plugin-transform-new-target-7.14.5.tgz", + "integrity": "sha512-Nx054zovz6IIRWEB49RDRuXGI4Gy0GMgqG0cII9L3MxqgXz/+rgII+RU58qpo4g7tNEx1jG7rRVH4ihZoP4esQ==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-object-super": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-object-super/-/plugin-transform-object-super-7.14.5.tgz", + "integrity": "sha512-MKfOBWzK0pZIrav9z/hkRqIk/2bTv9qvxHzPQc12RcVkMOzpIKnFCNYJip00ssKWYkd8Sf5g0Wr7pqJ+cmtuFg==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/helper-replace-supers": "^7.14.5" + } + }, + "@babel/plugin-transform-parameters": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-parameters/-/plugin-transform-parameters-7.14.5.tgz", + "integrity": "sha512-Tl7LWdr6HUxTmzQtzuU14SqbgrSKmaR77M0OKyq4njZLQTPfOvzblNKyNkGwOfEFCEx7KeYHQHDI0P3F02IVkA==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-react-jsx": { + "version": "7.3.0", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-react-jsx/-/plugin-transform-react-jsx-7.3.0.tgz", + "integrity": "sha512-a/+aRb7R06WcKvQLOu4/TpjKOdvVEKRLWFpKcNuHhiREPgGRB4TQJxq07+EZLS8LFVYpfq1a5lDUnuMdcCpBKg==", + "requires": { + "@babel/helper-builder-react-jsx": "^7.3.0", + "@babel/helper-plugin-utils": "^7.0.0", + "@babel/plugin-syntax-jsx": "^7.2.0" + } + }, + "@babel/plugin-transform-regenerator": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-regenerator/-/plugin-transform-regenerator-7.14.5.tgz", + "integrity": "sha512-NVIY1W3ITDP5xQl50NgTKlZ0GrotKtLna08/uGY6ErQt6VEQZXla86x/CTddm5gZdcr+5GSsvMeTmWA5Ii6pkg==", + "requires": { + "regenerator-transform": "^0.14.2" + } + }, + "@babel/plugin-transform-shorthand-properties": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-shorthand-properties/-/plugin-transform-shorthand-properties-7.14.5.tgz", + "integrity": "sha512-xLucks6T1VmGsTB+GWK5Pl9Jl5+nRXD1uoFdA5TSO6xtiNjtXTjKkmPdFXVLGlK5A2/or/wQMKfmQ2Y0XJfn5g==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-spread": { + "version": "7.14.6", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-spread/-/plugin-transform-spread-7.14.6.tgz", + "integrity": "sha512-Zr0x0YroFJku7n7+/HH3A2eIrGMjbmAIbJSVv0IZ+t3U2WUQUA64S/oeied2e+MaGSjmt4alzBCsK9E8gh+fag==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5", + "@babel/helper-skip-transparent-expression-wrappers": "^7.14.5" + } + }, + "@babel/plugin-transform-sticky-regex": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-sticky-regex/-/plugin-transform-sticky-regex-7.14.5.tgz", + "integrity": "sha512-Z7F7GyvEMzIIbwnziAZmnSNpdijdr4dWt+FJNBnBLz5mwDFkqIXU9wmBcWWad3QeJF5hMTkRe4dAq2sUZiG+8A==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-template-literals": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-template-literals/-/plugin-transform-template-literals-7.14.5.tgz", + "integrity": "sha512-22btZeURqiepOfuy/VkFr+zStqlujWaarpMErvay7goJS6BWwdd6BY9zQyDLDa4x2S3VugxFb162IZ4m/S/+Gg==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-typeof-symbol": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-typeof-symbol/-/plugin-transform-typeof-symbol-7.14.5.tgz", + "integrity": "sha512-lXzLD30ffCWseTbMQzrvDWqljvZlHkXU+CnseMhkMNqU1sASnCsz3tSzAaH3vCUXb9PHeUb90ZT1BdFTm1xxJw==", + "requires": { + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/plugin-transform-unicode-regex": { + "version": "7.14.5", + "resolved": "https://registry.npmjs.org/@babel/plugin-transform-unicode-regex/-/plugin-transform-unicode-regex-7.14.5.tgz", + "integrity": "sha512-UygduJpC5kHeCiRw/xDVzC+wj8VaYSoKl5JNVmbP7MadpNinAm3SvZCxZ42H37KZBKztz46YC73i9yV34d0Tzw==", + "requires": { + "@babel/helper-create-regexp-features-plugin": "^7.14.5", + "@babel/helper-plugin-utils": "^7.14.5" + } + }, + "@babel/preset-env": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/preset-env/-/preset-env-7.3.4.tgz", + "integrity": "sha512-2mwqfYMK8weA0g0uBKOt4FE3iEodiHy9/CW0b+nWXcbL+pGzLx8ESYc+j9IIxr6LTDHWKgPm71i9smo02bw+gA==", + "requires": { + "@babel/helper-module-imports": "^7.0.0", + "@babel/helper-plugin-utils": "^7.0.0", + "@babel/plugin-proposal-async-generator-functions": "^7.2.0", + "@babel/plugin-proposal-json-strings": "^7.2.0", + "@babel/plugin-proposal-object-rest-spread": "^7.3.4", + "@babel/plugin-proposal-optional-catch-binding": "^7.2.0", + "@babel/plugin-proposal-unicode-property-regex": "^7.2.0", + "@babel/plugin-syntax-async-generators": "^7.2.0", + "@babel/plugin-syntax-json-strings": "^7.2.0", + "@babel/plugin-syntax-object-rest-spread": "^7.2.0", + "@babel/plugin-syntax-optional-catch-binding": "^7.2.0", + "@babel/plugin-transform-arrow-functions": "^7.2.0", + "@babel/plugin-transform-async-to-generator": "^7.3.4", + "@babel/plugin-transform-block-scoped-functions": "^7.2.0", + "@babel/plugin-transform-block-scoping": "^7.3.4", + "@babel/plugin-transform-classes": "^7.3.4", + "@babel/plugin-transform-computed-properties": "^7.2.0", + "@babel/plugin-transform-destructuring": "^7.2.0", + "@babel/plugin-transform-dotall-regex": "^7.2.0", + "@babel/plugin-transform-duplicate-keys": "^7.2.0", + "@babel/plugin-transform-exponentiation-operator": "^7.2.0", + "@babel/plugin-transform-for-of": "^7.2.0", + "@babel/plugin-transform-function-name": "^7.2.0", + "@babel/plugin-transform-literals": "^7.2.0", + "@babel/plugin-transform-modules-amd": "^7.2.0", + "@babel/plugin-transform-modules-commonjs": "^7.2.0", + "@babel/plugin-transform-modules-systemjs": "^7.3.4", + "@babel/plugin-transform-modules-umd": "^7.2.0", + "@babel/plugin-transform-named-capturing-groups-regex": "^7.3.0", + "@babel/plugin-transform-new-target": "^7.0.0", + "@babel/plugin-transform-object-super": "^7.2.0", + "@babel/plugin-transform-parameters": "^7.2.0", + "@babel/plugin-transform-regenerator": "^7.3.4", + "@babel/plugin-transform-shorthand-properties": "^7.2.0", + "@babel/plugin-transform-spread": "^7.2.0", + "@babel/plugin-transform-sticky-regex": "^7.2.0", + "@babel/plugin-transform-template-literals": "^7.2.0", + "@babel/plugin-transform-typeof-symbol": "^7.2.0", + "@babel/plugin-transform-unicode-regex": "^7.2.0", + "browserslist": "^4.3.4", + "invariant": "^2.2.2", + "js-levenshtein": "^1.1.3", + "semver": "^5.3.0" + } + }, + "@babel/runtime": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/runtime/-/runtime-7.3.4.tgz", + "integrity": "sha512-IvfvnMdSaLBateu0jfsYIpZTxAc2cKEXEMiezGGN75QcBcecDUKd3PgLAncT0oOgxKy8dd8hrJKj9MfzgfZd6g==", + "requires": { + "regenerator-runtime": "^0.12.0" + }, + "dependencies": { + "regenerator-runtime": { + "version": "0.12.1", + "resolved": "https://registry.npmjs.org/regenerator-runtime/-/regenerator-runtime-0.12.1.tgz", + "integrity": "sha512-odxIc1/vDlo4iZcfXqRYFj0vpXFNoGdKMAUieAlFYO6m/nl5e9KR/beGf41z4a1FI+aQgtjhuaSlDxQ0hmkrHg==" + } + } + }, + "@babel/template": { + "version": "7.2.2", + "resolved": "https://registry.npmjs.org/@babel/template/-/template-7.2.2.tgz", + "integrity": "sha512-zRL0IMM02AUDwghf5LMSSDEz7sBCO2YnNmpg3uWTZj/v1rcG2BmQUvaGU8GhU8BvfMh1k2KIAYZ7Ji9KXPUg7g==", + "requires": { + "@babel/code-frame": "^7.0.0", + "@babel/parser": "^7.2.2", + "@babel/types": "^7.2.2" + } + }, + "@babel/traverse": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/traverse/-/traverse-7.3.4.tgz", + "integrity": "sha512-TvTHKp6471OYEcE/91uWmhR6PrrYywQntCHSaZ8CM8Vmp+pjAusal4nGB2WCCQd0rvI7nOMKn9GnbcvTUz3/ZQ==", + "requires": { + "@babel/code-frame": "^7.0.0", + "@babel/generator": "^7.3.4", + "@babel/helper-function-name": "^7.1.0", + "@babel/helper-split-export-declaration": "^7.0.0", + "@babel/parser": "^7.3.4", + "@babel/types": "^7.3.4", + "debug": "^4.1.0", + "globals": "^11.1.0", + "lodash": "^4.17.11" + } + }, + "@babel/types": { + "version": "7.3.4", + "resolved": "https://registry.npmjs.org/@babel/types/-/types-7.3.4.tgz", + "integrity": "sha512-WEkp8MsLftM7O/ty580wAmZzN1nDmCACc5+jFzUt+GUFNNIi3LdRlueYz0YIlmJhlZx1QYDMZL5vdWCL0fNjFQ==", + "requires": { + "esutils": "^2.0.2", + "lodash": "^4.17.11", + "to-fast-properties": "^2.0.0" + } + }, + "@discoveryjs/json-ext": { + "version": "0.5.3", + "resolved": "https://registry.npmjs.org/@discoveryjs/json-ext/-/json-ext-0.5.3.tgz", + "integrity": "sha512-Fxt+AfXgjMoin2maPIYzFZnQjAXjAL0PHscM5pRTtatFqB+vZxAM9tLp2Optnuw3QOQC40jTNeGYFOMvyf7v9g==" + }, + "@iarna/toml": { + "version": "2.2.5", + "resolved": "https://registry.npmjs.org/@iarna/toml/-/toml-2.2.5.tgz", + "integrity": "sha512-trnsAYxU3xnS1gPHPyU961coFyLkh4gAD/0zQ5mymY4yOZ+CYvsPqUbOFSw0aDM4y0tV7tiFxL/1XfXPNC6IPg==" + }, + "@mrmlnc/readdir-enhanced": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/@mrmlnc/readdir-enhanced/-/readdir-enhanced-2.2.1.tgz", + "integrity": "sha512-bPHp6Ji8b41szTOcaP63VlnbbO5Ny6dwAATtY6JTjh5N2OLrb5Qk/Th5cRkRQhkWCt+EJsYrNB0MiL+Gpn6e3g==", + "requires": { + "call-me-maybe": "^1.0.1", + "glob-to-regexp": "^0.3.0" + } + }, + "@nodelib/fs.stat": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/@nodelib/fs.stat/-/fs.stat-1.1.3.tgz", + "integrity": "sha512-shAmDyaQC4H92APFoIaVDHCx5bStIocgvbwQyxPRrbUY20V1EYTbSDchWbuwlMG3V17cprZhA6+78JfB+3DTPw==" + }, + "@parcel/fs": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@parcel/fs/-/fs-1.11.0.tgz", + "integrity": "sha512-86RyEqULbbVoeo8OLcv+LQ1Vq2PKBAvWTU9fCgALxuCTbbs5Ppcvll4Vr+Ko1AnmMzja/k++SzNAwJfeQXVlpA==", + "requires": { + "@parcel/utils": "^1.11.0", + "mkdirp": "^0.5.1", + "rimraf": "^2.6.2" + } + }, + "@parcel/logger": { + "version": "1.11.1", + "resolved": "https://registry.npmjs.org/@parcel/logger/-/logger-1.11.1.tgz", + "integrity": "sha512-9NF3M6UVeP2udOBDILuoEHd8VrF4vQqoWHEafymO1pfSoOMfxrSJZw1MfyAAIUN/IFp9qjcpDCUbDZB+ioVevA==", + "requires": { + "@parcel/workers": "^1.11.0", + "chalk": "^2.1.0", + "grapheme-breaker": "^0.3.2", + "ora": "^2.1.0", + "strip-ansi": "^4.0.0" + } + }, + "@parcel/utils": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@parcel/utils/-/utils-1.11.0.tgz", + "integrity": "sha512-cA3p4jTlaMeOtAKR/6AadanOPvKeg8VwgnHhOyfi0yClD0TZS/hi9xu12w4EzA/8NtHu0g6o4RDfcNjqN8l1AQ==" + }, + "@parcel/watcher": { + "version": "1.12.1", + "resolved": "https://registry.npmjs.org/@parcel/watcher/-/watcher-1.12.1.tgz", + "integrity": "sha512-od+uCtCxC/KoNQAIE1vWx1YTyKYY+7CTrxBJPRh3cDWw/C0tCtlBMVlrbplscGoEpt6B27KhJDCv82PBxOERNA==", + "requires": { + "@parcel/utils": "^1.11.0", + "chokidar": "^2.1.5" + } + }, + "@parcel/workers": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@parcel/workers/-/workers-1.11.0.tgz", + "integrity": "sha512-USSjRAAQYsZFlv43FUPdD+jEGML5/8oLF0rUzPQTtK4q9kvaXr49F5ZplyLz5lox78cLZ0TxN2bIDQ1xhOkulQ==", + "requires": { + "@parcel/utils": "^1.11.0", + "physical-cpu-count": "^2.0.0" + } + }, + "@types/eslint": { + "version": "7.2.13", + "resolved": "https://registry.npmjs.org/@types/eslint/-/eslint-7.2.13.tgz", + "integrity": "sha512-LKmQCWAlnVHvvXq4oasNUMTJJb2GwSyTY8+1C7OH5ILR8mPLaljv1jxL1bXW3xB3jFbQxTKxJAvI8PyjB09aBg==", + "requires": { + "@types/estree": "*", + "@types/json-schema": "*" + } + }, + "@types/eslint-scope": { + "version": "3.7.0", + "resolved": "https://registry.npmjs.org/@types/eslint-scope/-/eslint-scope-3.7.0.tgz", + "integrity": "sha512-O/ql2+rrCUe2W2rs7wMR+GqPRcgB6UiqN5RhrR5xruFlY7l9YLMn0ZkDzjoHLeiFkR8MCQZVudUuuvQ2BLC9Qw==", + "requires": { + "@types/eslint": "*", + "@types/estree": "*" + } + }, + "@types/estree": { + "version": "0.0.47", + "resolved": "https://registry.npmjs.org/@types/estree/-/estree-0.0.47.tgz", + "integrity": "sha512-c5ciR06jK8u9BstrmJyO97m+klJrrhCf9u3rLu3DEAJBirxRqSCvDQoYKmxuYwQI5SZChAWu+tq9oVlGRuzPAg==" + }, + "@types/glob": { + "version": "7.1.3", + "resolved": "https://registry.npmjs.org/@types/glob/-/glob-7.1.3.tgz", + "integrity": "sha512-SEYeGAIQIQX8NN6LDKprLjbrd5dARM5EXsd8GI/A5l0apYI1fGMWgPHSe4ZKL4eozlAyI+doUE9XbYS4xCkQ1w==", + "requires": { + "@types/minimatch": "*", + "@types/node": "*" + } + }, + "@types/html-minifier-terser": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/@types/html-minifier-terser/-/html-minifier-terser-5.1.1.tgz", + "integrity": "sha512-giAlZwstKbmvMk1OO7WXSj4OZ0keXAcl2TQq4LWHiiPH2ByaH7WeUzng+Qej8UPxxv+8lRTuouo0iaNDBuzIBA==" + }, + "@types/json-schema": { + "version": "7.0.7", + "resolved": "https://registry.npmjs.org/@types/json-schema/-/json-schema-7.0.7.tgz", + "integrity": "sha512-cxWFQVseBm6O9Gbw1IWb8r6OS4OhSt3hPZLkFApLjM8TEXROBuQGLAH2i2gZpcXdLBIrpXuTDhH7Vbm1iXmNGA==" + }, + "@types/minimatch": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/@types/minimatch/-/minimatch-3.0.4.tgz", + "integrity": "sha512-1z8k4wzFnNjVK/tlxvrWuK5WMt6mydWWP7+zvH5eFep4oj+UkrfiJTRtjCeBXNpwaA/FYqqtb4/QS4ianFpIRA==" + }, + "@types/node": { + "version": "15.12.5", + "resolved": "https://registry.npmjs.org/@types/node/-/node-15.12.5.tgz", + "integrity": "sha512-se3yX7UHv5Bscf8f1ERKvQOD6sTyycH3hdaoozvaLxgUiY5lIGEeH37AD0G0Qi9kPqihPn0HOfd2yaIEN9VwEg==" + }, + "@types/q": { + "version": "1.5.4", + "resolved": "https://registry.npmjs.org/@types/q/-/q-1.5.4.tgz", + "integrity": "sha512-1HcDas8SEj4z1Wc696tH56G8OlRaH/sqZOynNNB+HF0WOeXPaxTtbYzJY2oEfiUxjSKjhCKr+MvR7dCHcEelug==" + }, + "@webassemblyjs/ast": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/ast/-/ast-1.11.0.tgz", + "integrity": "sha512-kX2W49LWsbthrmIRMbQZuQDhGtjyqXfEmmHyEi4XWnSZtPmxY0+3anPIzsnRb45VH/J55zlOfWvZuY47aJZTJg==", + "requires": { + "@webassemblyjs/helper-numbers": "1.11.0", + "@webassemblyjs/helper-wasm-bytecode": "1.11.0" + } + }, + "@webassemblyjs/floating-point-hex-parser": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/floating-point-hex-parser/-/floating-point-hex-parser-1.11.0.tgz", + "integrity": "sha512-Q/aVYs/VnPDVYvsCBL/gSgwmfjeCb4LW8+TMrO3cSzJImgv8lxxEPM2JA5jMrivE7LSz3V+PFqtMbls3m1exDA==" + }, + "@webassemblyjs/helper-api-error": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/helper-api-error/-/helper-api-error-1.11.0.tgz", + "integrity": "sha512-baT/va95eXiXb2QflSx95QGT5ClzWpGaa8L7JnJbgzoYeaA27FCvuBXU758l+KXWRndEmUXjP0Q5fibhavIn8w==" + }, + "@webassemblyjs/helper-buffer": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/helper-buffer/-/helper-buffer-1.11.0.tgz", + "integrity": "sha512-u9HPBEl4DS+vA8qLQdEQ6N/eJQ7gT7aNvMIo8AAWvAl/xMrcOSiI2M0MAnMCy3jIFke7bEee/JwdX1nUpCtdyA==" + }, + "@webassemblyjs/helper-numbers": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/helper-numbers/-/helper-numbers-1.11.0.tgz", + "integrity": "sha512-DhRQKelIj01s5IgdsOJMKLppI+4zpmcMQ3XboFPLwCpSNH6Hqo1ritgHgD0nqHeSYqofA6aBN/NmXuGjM1jEfQ==", + "requires": { + "@webassemblyjs/floating-point-hex-parser": "1.11.0", + "@webassemblyjs/helper-api-error": "1.11.0", + "@xtuc/long": "4.2.2" + } + }, + "@webassemblyjs/helper-wasm-bytecode": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/helper-wasm-bytecode/-/helper-wasm-bytecode-1.11.0.tgz", + "integrity": "sha512-MbmhvxXExm542tWREgSFnOVo07fDpsBJg3sIl6fSp9xuu75eGz5lz31q7wTLffwL3Za7XNRCMZy210+tnsUSEA==" + }, + "@webassemblyjs/helper-wasm-section": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/helper-wasm-section/-/helper-wasm-section-1.11.0.tgz", + "integrity": "sha512-3Eb88hcbfY/FCukrg6i3EH8H2UsD7x8Vy47iVJrP967A9JGqgBVL9aH71SETPx1JrGsOUVLo0c7vMCN22ytJew==", + "requires": { + "@webassemblyjs/ast": "1.11.0", + "@webassemblyjs/helper-buffer": "1.11.0", + "@webassemblyjs/helper-wasm-bytecode": "1.11.0", + "@webassemblyjs/wasm-gen": "1.11.0" + } + }, + "@webassemblyjs/ieee754": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/ieee754/-/ieee754-1.11.0.tgz", + "integrity": "sha512-KXzOqpcYQwAfeQ6WbF6HXo+0udBNmw0iXDmEK5sFlmQdmND+tr773Ti8/5T/M6Tl/413ArSJErATd8In3B+WBA==", + "requires": { + "@xtuc/ieee754": "^1.2.0" + } + }, + "@webassemblyjs/leb128": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/leb128/-/leb128-1.11.0.tgz", + "integrity": "sha512-aqbsHa1mSQAbeeNcl38un6qVY++hh8OpCOzxhixSYgbRfNWcxJNJQwe2rezK9XEcssJbbWIkblaJRwGMS9zp+g==", + "requires": { + "@xtuc/long": "4.2.2" + } + }, + "@webassemblyjs/utf8": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/utf8/-/utf8-1.11.0.tgz", + "integrity": "sha512-A/lclGxH6SpSLSyFowMzO/+aDEPU4hvEiooCMXQPcQFPPJaYcPQNKGOCLUySJsYJ4trbpr+Fs08n4jelkVTGVw==" + }, + "@webassemblyjs/wasm-edit": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/wasm-edit/-/wasm-edit-1.11.0.tgz", + "integrity": "sha512-JHQ0damXy0G6J9ucyKVXO2j08JVJ2ntkdJlq1UTiUrIgfGMmA7Ik5VdC/L8hBK46kVJgujkBIoMtT8yVr+yVOQ==", + "requires": { + "@webassemblyjs/ast": "1.11.0", + "@webassemblyjs/helper-buffer": "1.11.0", + "@webassemblyjs/helper-wasm-bytecode": "1.11.0", + "@webassemblyjs/helper-wasm-section": "1.11.0", + "@webassemblyjs/wasm-gen": "1.11.0", + "@webassemblyjs/wasm-opt": "1.11.0", + "@webassemblyjs/wasm-parser": "1.11.0", + "@webassemblyjs/wast-printer": "1.11.0" + } + }, + "@webassemblyjs/wasm-gen": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/wasm-gen/-/wasm-gen-1.11.0.tgz", + "integrity": "sha512-BEUv1aj0WptCZ9kIS30th5ILASUnAPEvE3tVMTrItnZRT9tXCLW2LEXT8ezLw59rqPP9klh9LPmpU+WmRQmCPQ==", + "requires": { + "@webassemblyjs/ast": "1.11.0", + "@webassemblyjs/helper-wasm-bytecode": "1.11.0", + "@webassemblyjs/ieee754": "1.11.0", + "@webassemblyjs/leb128": "1.11.0", + "@webassemblyjs/utf8": "1.11.0" + } + }, + "@webassemblyjs/wasm-opt": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/wasm-opt/-/wasm-opt-1.11.0.tgz", + "integrity": "sha512-tHUSP5F4ywyh3hZ0+fDQuWxKx3mJiPeFufg+9gwTpYp324mPCQgnuVKwzLTZVqj0duRDovnPaZqDwoyhIO8kYg==", + "requires": { + "@webassemblyjs/ast": "1.11.0", + "@webassemblyjs/helper-buffer": "1.11.0", + "@webassemblyjs/wasm-gen": "1.11.0", + "@webassemblyjs/wasm-parser": "1.11.0" + } + }, + "@webassemblyjs/wasm-parser": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/wasm-parser/-/wasm-parser-1.11.0.tgz", + "integrity": "sha512-6L285Sgu9gphrcpDXINvm0M9BskznnzJTE7gYkjDbxET28shDqp27wpruyx3C2S/dvEwiigBwLA1cz7lNUi0kw==", + "requires": { + "@webassemblyjs/ast": "1.11.0", + "@webassemblyjs/helper-api-error": "1.11.0", + "@webassemblyjs/helper-wasm-bytecode": "1.11.0", + "@webassemblyjs/ieee754": "1.11.0", + "@webassemblyjs/leb128": "1.11.0", + "@webassemblyjs/utf8": "1.11.0" + } + }, + "@webassemblyjs/wast-printer": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/@webassemblyjs/wast-printer/-/wast-printer-1.11.0.tgz", + "integrity": "sha512-Fg5OX46pRdTgB7rKIUojkh9vXaVN6sGYCnEiJN1GYkb0RPwShZXp6KTDqmoMdQPKhcroOXh3fEzmkWmCYaKYhQ==", + "requires": { + "@webassemblyjs/ast": "1.11.0", + "@xtuc/long": "4.2.2" + } + }, + "@webpack-cli/configtest": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/@webpack-cli/configtest/-/configtest-1.0.4.tgz", + "integrity": "sha512-cs3XLy+UcxiP6bj0A6u7MLLuwdXJ1c3Dtc0RkKg+wiI1g/Ti1om8+/2hc2A2B60NbBNAbMgyBMHvyymWm/j4wQ==" + }, + "@webpack-cli/info": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/@webpack-cli/info/-/info-1.3.0.tgz", + "integrity": "sha512-ASiVB3t9LOKHs5DyVUcxpraBXDOKubYu/ihHhU+t1UPpxsivg6Od2E2qU4gJCekfEddzRBzHhzA/Acyw/mlK/w==", + "requires": { + "envinfo": "^7.7.3" + } + }, + "@webpack-cli/serve": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/@webpack-cli/serve/-/serve-1.5.1.tgz", + "integrity": "sha512-4vSVUiOPJLmr45S8rMGy7WDvpWxfFxfP/Qx/cxZFCfvoypTYpPPL1X8VIZMe0WTA+Jr7blUxwUSEZNkjoMTgSw==" + }, + "@xtuc/ieee754": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/@xtuc/ieee754/-/ieee754-1.2.0.tgz", + "integrity": "sha512-DX8nKgqcGwsc0eJSqYt5lwP4DH5FlHnmuWWBRy7X0NcaGR0ZtuyeESgMwTYVEtxmsNGY+qit4QYT/MIYTOTPeA==" + }, + "@xtuc/long": { + "version": "4.2.2", + "resolved": "https://registry.npmjs.org/@xtuc/long/-/long-4.2.2.tgz", + "integrity": "sha512-NuHqBY1PB/D8xU6s/thBgOAiAP7HOYDQ32+BFZILJ8ivkUkAHQnWfn6WhL79Owj1qmUnoN/YPhktdIoucipkAQ==" + }, + "abab": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/abab/-/abab-2.0.5.tgz", + "integrity": "sha512-9IK9EadsbHo6jLWIpxpR6pL0sazTXV6+SQv25ZB+F7Bj9mJNaOc4nCRabwd5M/JwmUa8idz6Eci6eKfJryPs6Q==" + }, + "abbrev": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/abbrev/-/abbrev-1.1.1.tgz", + "integrity": "sha512-nne9/IiQ/hzIhY6pdDnbBtz7DjPTKrY00P/zvPSm5pOFkl6xuGrGnXn/VtTNNfNtAfZ9/1RtehkszU9qcTii0Q==" + }, + "accepts": { + "version": "1.3.7", + "resolved": "https://registry.npmjs.org/accepts/-/accepts-1.3.7.tgz", + "integrity": "sha512-Il80Qs2WjYlJIBNzNkK6KYqlVMTbZLXgHx2oT0pU/fjRHyEp+PEfEPY0R3WCwAGVOtauxh1hOxNgIf5bv7dQpA==", + "requires": { + "mime-types": "~2.1.24", + "negotiator": "0.6.2" + } + }, + "acorn": { + "version": "7.4.1", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-7.4.1.tgz", + "integrity": "sha512-nQyp0o1/mNdbTO1PO6kHkwSrmgZ0MT/jCCpNiwbUjGoRN4dlBhqJtoQuCnEOKzgTVwg0ZWiCoQy6SxMebQVh8A==" + }, + "acorn-globals": { + "version": "4.3.4", + "resolved": "https://registry.npmjs.org/acorn-globals/-/acorn-globals-4.3.4.tgz", + "integrity": "sha512-clfQEh21R+D0leSbUdWf3OcfqyaCSAQ8Ryq00bofSekfr9W8u1jyYZo6ir0xu9Gtcf7BjcHJpnbZH7JOCpP60A==", + "requires": { + "acorn": "^6.0.1", + "acorn-walk": "^6.0.1" + }, + "dependencies": { + "acorn": { + "version": "6.4.2", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-6.4.2.tgz", + "integrity": "sha512-XtGIhXwF8YM8bJhGxG5kXgjkEuNGLTkoYqVE+KMR+aspr4KGYmKYg7yUe3KghyQ9yheNwLnjmzh/7+gfDBmHCQ==" + } + } + }, + "acorn-walk": { + "version": "6.2.0", + "resolved": "https://registry.npmjs.org/acorn-walk/-/acorn-walk-6.2.0.tgz", + "integrity": "sha512-7evsyfH1cLOCdAzZAd43Cic04yKydNx0cF+7tiA19p1XnLLPU4dpCQOqpjqwokFe//vS0QqfqqjCS2JkiIs0cA==" + }, + "ajv": { + "version": "6.12.6", + "resolved": "https://registry.npmjs.org/ajv/-/ajv-6.12.6.tgz", + "integrity": "sha512-j3fVLgvTo527anyYyJOGTYJbG+vnnQYvE0m5mmkc1TK+nxAppkCLMIL0aZ4dblVCNoGShhm+kzE4ZUykBoMg4g==", + "requires": { + "fast-deep-equal": "^3.1.1", + "fast-json-stable-stringify": "^2.0.0", + "json-schema-traverse": "^0.4.1", + "uri-js": "^4.2.2" + } + }, + "ajv-errors": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/ajv-errors/-/ajv-errors-1.0.1.tgz", + "integrity": "sha512-DCRfO/4nQ+89p/RK43i8Ezd41EqdGIU4ld7nGF8OQ14oc/we5rEntLCUa7+jrn3nn83BosfwZA0wb4pon2o8iQ==" + }, + "ajv-keywords": { + "version": "3.5.2", + "resolved": "https://registry.npmjs.org/ajv-keywords/-/ajv-keywords-3.5.2.tgz", + "integrity": "sha512-5p6WTN0DdTGVQk6VjcEju19IgaHudalcfabD7yhDGeA6bcQnmL+CpveLJq/3hvfwd1aof6L386Ougkx6RfyMIQ==" + }, + "alphanum-sort": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/alphanum-sort/-/alphanum-sort-1.0.2.tgz", + "integrity": "sha1-l6ERlkmyEa0zaR2fn0hqjsn74KM=" + }, + "ansi-colors": { + "version": "3.2.4", + "resolved": "https://registry.npmjs.org/ansi-colors/-/ansi-colors-3.2.4.tgz", + "integrity": "sha512-hHUXGagefjN2iRrID63xckIvotOXOojhQKWIPUZ4mNUZ9nLZW+7FMNoE1lOkEhNWYsx/7ysGIuJYCiMAA9FnrA==" + }, + "ansi-escapes": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/ansi-escapes/-/ansi-escapes-3.2.0.tgz", + "integrity": "sha512-cBhpre4ma+U0T1oM5fXg7Dy1Jw7zzwv7lt/GoCpr+hDQJoYnKVPLL4dCvSEFMmQurOQvSrwT7SL/DAlhBI97RQ==" + }, + "ansi-html": { + "version": "0.0.7", + "resolved": "https://registry.npmjs.org/ansi-html/-/ansi-html-0.0.7.tgz", + "integrity": "sha1-gTWEAhliqenm/QOflA0S9WynhZ4=" + }, + "ansi-regex": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-3.0.0.tgz", + "integrity": "sha1-7QMXwyIGT3lGbAKWa922Bas32Zg=" + }, + "ansi-styles": { + "version": "3.2.1", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-3.2.1.tgz", + "integrity": "sha512-VT0ZI6kZRdTh8YyJw3SMbYm/u+NqfsAxEpWO0Pf9sq8/e94WxxOpPKx9FR1FlyCtOVDNOQ+8ntlqFxiRc+r5qA==", + "requires": { + "color-convert": "^1.9.0" + } + }, + "ansi-to-html": { + "version": "0.6.15", + "resolved": "https://registry.npmjs.org/ansi-to-html/-/ansi-to-html-0.6.15.tgz", + "integrity": "sha512-28ijx2aHJGdzbs+O5SNQF65r6rrKYnkuwTYm8lZlChuoJ9P1vVzIpWO20sQTqTPDXYp6NFwk326vApTtLVFXpQ==", + "requires": { + "entities": "^2.0.0" + } + }, + "anymatch": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/anymatch/-/anymatch-2.0.0.tgz", + "integrity": "sha512-5teOsQWABXHHBFP9y3skS5P3d/WfWXpv3FUpy+LorMrNYaT9pI4oLMQX7jzQ2KklNpGpWHzdCXTDT2Y3XGlZBw==", + "requires": { + "micromatch": "^3.1.4", + "normalize-path": "^2.1.1" + }, + "dependencies": { + "normalize-path": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/normalize-path/-/normalize-path-2.1.1.tgz", + "integrity": "sha1-GrKLVW4Zg2Oowab35vogE3/mrtk=", + "requires": { + "remove-trailing-separator": "^1.0.1" + } + } + } + }, + "aproba": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/aproba/-/aproba-1.2.0.tgz", + "integrity": "sha512-Y9J6ZjXtoYh8RnXVCMOU/ttDmk1aBjunq9vO0ta5x85WDQiQfUF9sIPBITdbiiIVcBo03Hi3jMxigBtsddlXRw==" + }, + "arch": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/arch/-/arch-2.2.0.tgz", + "integrity": "sha512-Of/R0wqp83cgHozfIYLbBMnej79U/SVGOOyuB3VVFv1NRM/PSFMK12x9KVtiYzJqmnU5WR2qp0Z5rHb7sWGnFQ==" + }, + "argparse": { + "version": "1.0.10", + "resolved": "https://registry.npmjs.org/argparse/-/argparse-1.0.10.tgz", + "integrity": "sha512-o5Roy6tNG4SL/FOkCAN6RzjiakZS25RLYFrcMttJqbdd8BWrnA+fGz57iN5Pb06pvBGvl5gQ0B48dJlslXvoTg==", + "requires": { + "sprintf-js": "~1.0.2" + } + }, + "arr-diff": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/arr-diff/-/arr-diff-4.0.0.tgz", + "integrity": "sha1-1kYQdP6/7HHn4VI1dhoyml3HxSA=" + }, + "arr-flatten": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/arr-flatten/-/arr-flatten-1.1.0.tgz", + "integrity": "sha512-L3hKV5R/p5o81R7O02IGnwpDmkp6E982XhtbuwSe3O4qOtMMMtodicASA1Cny2U+aCXcNpml+m4dPsvsJ3jatg==" + }, + "arr-union": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/arr-union/-/arr-union-3.1.0.tgz", + "integrity": "sha1-45sJrqne+Gao8gbiiK9jkZuuOcQ=" + }, + "array-equal": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/array-equal/-/array-equal-1.0.0.tgz", + "integrity": "sha1-jCpe8kcv2ep0KwTHenUJO6J1fJM=" + }, + "array-flatten": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/array-flatten/-/array-flatten-2.1.2.tgz", + "integrity": "sha512-hNfzcOV8W4NdualtqBFPyVO+54DSJuZGY9qT4pRroB6S9e3iiido2ISIC5h9R2sPJ8H3FHCIiEnsv1lPXO3KtQ==" + }, + "array-union": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/array-union/-/array-union-1.0.2.tgz", + "integrity": "sha1-mjRBDk9OPaI96jdb5b5w8kd47Dk=", + "requires": { + "array-uniq": "^1.0.1" + } + }, + "array-uniq": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/array-uniq/-/array-uniq-1.0.3.tgz", + "integrity": "sha1-r2rId6Jcx/dOBYiUdThY39sk/bY=" + }, + "array-unique": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/array-unique/-/array-unique-0.3.2.tgz", + "integrity": "sha1-qJS3XUvE9s1nnvMkSp/Y9Gri1Cg=" + }, + "arrify": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/arrify/-/arrify-1.0.1.tgz", + "integrity": "sha1-iYUI2iIm84DfkEcoRWhJwVAaSw0=" + }, + "asn1": { + "version": "0.2.4", + "resolved": "https://registry.npmjs.org/asn1/-/asn1-0.2.4.tgz", + "integrity": "sha512-jxwzQpLQjSmWXgwaCZE9Nz+glAG01yF1QnWgbhGwHI5A6FRIEY6IVqtHhIepHqI7/kyEyQEagBC5mBEFlIYvdg==", + "requires": { + "safer-buffer": "~2.1.0" + } + }, + "asn1.js": { + "version": "5.4.1", + "resolved": "https://registry.npmjs.org/asn1.js/-/asn1.js-5.4.1.tgz", + "integrity": "sha512-+I//4cYPccV8LdmBLiX8CYvf9Sp3vQsrqu2QNXRcrbiWvcx/UdlFiqUJJzxRQxgsZmvhXhn4cSKeSmoFjVdupA==", + "requires": { + "bn.js": "^4.0.0", + "inherits": "^2.0.1", + "minimalistic-assert": "^1.0.0", + "safer-buffer": "^2.1.0" + }, + "dependencies": { + "bn.js": { + "version": "4.12.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.0.tgz", + "integrity": "sha512-c98Bf3tPniI+scsdk237ku1Dc3ujXQTSgyiPUDEOe7tRkhrqridvh8klBv0HCEso1OLOYcHuCv/cS6DNxKH+ZA==" + } + } + }, + "assert": { + "version": "1.5.0", + "resolved": "https://registry.npmjs.org/assert/-/assert-1.5.0.tgz", + "integrity": "sha512-EDsgawzwoun2CZkCgtxJbv392v4nbk9XDD06zI+kQYoBM/3RBWLlEyJARDOmhAAosBjWACEkKL6S+lIZtcAubA==", + "requires": { + "object-assign": "^4.1.1", + "util": "0.10.3" + }, + "dependencies": { + "inherits": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.1.tgz", + "integrity": "sha1-sX0I0ya0Qj5Wjv9xn5GwscvfafE=" + }, + "util": { + "version": "0.10.3", + "resolved": "https://registry.npmjs.org/util/-/util-0.10.3.tgz", + "integrity": "sha1-evsa/lCAUkZInj23/g7TeTNqwPk=", + "requires": { + "inherits": "2.0.1" + } + } + } + }, + "assert-plus": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/assert-plus/-/assert-plus-1.0.0.tgz", + "integrity": "sha1-8S4PPF13sLHN2RRpQuTpbB5N1SU=" + }, + "assign-symbols": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/assign-symbols/-/assign-symbols-1.0.0.tgz", + "integrity": "sha1-WWZ/QfrdTyDMvCu5a41Pf3jsA2c=" + }, + "async": { + "version": "2.6.3", + "resolved": "https://registry.npmjs.org/async/-/async-2.6.3.tgz", + "integrity": "sha512-zflvls11DCy+dQWzTW2dzuilv8Z5X/pjfmZOWba6TNIVDm+2UDaJmXSOXlasHKfNBs8oo3M0aT50fDEWfKZjXg==", + "requires": { + "lodash": "^4.17.14" + } + }, + "async-each": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/async-each/-/async-each-1.0.3.tgz", + "integrity": "sha512-z/WhQ5FPySLdvREByI2vZiTWwCnF0moMJ1hK9YQwDTHKh6I7/uSckMetoRGb5UBZPC1z0jlw+n/XCgjeH7y1AQ==" + }, + "async-limiter": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/async-limiter/-/async-limiter-1.0.1.tgz", + "integrity": "sha512-csOlWGAcRFJaI6m+F2WKdnMKr4HhdhFVBk0H/QbJFMCr+uO2kwohwXQPxw/9OCxp05r5ghVBFSyioixx3gfkNQ==" + }, + "asynckit": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", + "integrity": "sha1-x57Zf380y48robyXkLzDZkdLS3k=" + }, + "atob": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/atob/-/atob-2.1.2.tgz", + "integrity": "sha512-Wm6ukoaOGJi/73p/cl2GvLjTI5JM1k/O14isD73YML8StrH/7/lRFgmg8nICZgD3bZZvjwCGxtMOD3wWNAu8cg==" + }, + "aws-sign2": { + "version": "0.7.0", + "resolved": "https://registry.npmjs.org/aws-sign2/-/aws-sign2-0.7.0.tgz", + "integrity": "sha1-tG6JCTSpWR8tL2+G1+ap8bP+dqg=" + }, + "aws4": { + "version": "1.11.0", + "resolved": "https://registry.npmjs.org/aws4/-/aws4-1.11.0.tgz", + "integrity": "sha512-xh1Rl34h6Fi1DC2WWKfxUTVqRsNnr6LsKz2+hfwDxQJWmrx8+c7ylaqBMcHfl1U1r2dsifOvKX3LQuLNZ+XSvA==" + }, + "babel-plugin-dynamic-import-node": { + "version": "2.3.3", + "resolved": "https://registry.npmjs.org/babel-plugin-dynamic-import-node/-/babel-plugin-dynamic-import-node-2.3.3.tgz", + "integrity": "sha512-jZVI+s9Zg3IqA/kdi0i6UDCybUI3aSBLnglhYbSSjKlV7yF1F/5LWv8MakQmvYpnbJDS6fcBL2KzHSxNCMtWSQ==", + "requires": { + "object.assign": "^4.1.0" + } + }, + "babel-runtime": { + "version": "6.26.0", + "resolved": "https://registry.npmjs.org/babel-runtime/-/babel-runtime-6.26.0.tgz", + "integrity": "sha1-llxwWGaOgrVde/4E/yM3vItWR/4=", + "requires": { + "core-js": "^2.4.0", + "regenerator-runtime": "^0.11.0" + }, + "dependencies": { + "regenerator-runtime": { + "version": "0.11.1", + "resolved": "https://registry.npmjs.org/regenerator-runtime/-/regenerator-runtime-0.11.1.tgz", + "integrity": "sha512-MguG95oij0fC3QV3URf4V2SDYGJhJnJGqvIIgdECeODCT98wSWDAJ94SSuVpYQUoTcGUIL6L4yNB7j1DFFHSBg==" + } + } + }, + "babel-types": { + "version": "6.26.0", + "resolved": "https://registry.npmjs.org/babel-types/-/babel-types-6.26.0.tgz", + "integrity": "sha1-o7Bz+Uq0nrb6Vc1lInozQ4BjJJc=", + "requires": { + "babel-runtime": "^6.26.0", + "esutils": "^2.0.2", + "lodash": "^4.17.4", + "to-fast-properties": "^1.0.3" + }, + "dependencies": { + "to-fast-properties": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/to-fast-properties/-/to-fast-properties-1.0.3.tgz", + "integrity": "sha1-uDVx+k2MJbguIxsG46MFXeTKGkc=" + } + } + }, + "babylon-walk": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/babylon-walk/-/babylon-walk-1.0.2.tgz", + "integrity": "sha1-OxWl3btIKni0zpwByLoYFwLZ1s4=", + "requires": { + "babel-runtime": "^6.11.6", + "babel-types": "^6.15.0", + "lodash.clone": "^4.5.0" + } + }, + "balanced-match": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/balanced-match/-/balanced-match-1.0.2.tgz", + "integrity": "sha512-3oSeUO0TMV67hN1AmbXsK4yaqU7tjiHlbxRDZOpH0KW9+CeX4bRAaX0Anxt0tx2MrpRpWwQaPwIlISEJhYU5Pw==" + }, + "base": { + "version": "0.11.2", + "resolved": "https://registry.npmjs.org/base/-/base-0.11.2.tgz", + "integrity": "sha512-5T6P4xPgpp0YDFvSWwEZ4NoE3aM4QBQXDzmVbraCkFj8zHM+mba8SyqB5DbZWyR7mYHo6Y7BdQo3MoA4m0TeQg==", + "requires": { + "cache-base": "^1.0.1", + "class-utils": "^0.3.5", + "component-emitter": "^1.2.1", + "define-property": "^1.0.0", + "isobject": "^3.0.1", + "mixin-deep": "^1.2.0", + "pascalcase": "^0.1.1" + }, + "dependencies": { + "define-property": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-1.0.0.tgz", + "integrity": "sha1-dp66rz9KY6rTr56NMEybvnm/sOY=", + "requires": { + "is-descriptor": "^1.0.0" + } + }, + "is-accessor-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-accessor-descriptor/-/is-accessor-descriptor-1.0.0.tgz", + "integrity": "sha512-m5hnHTkcVsPfqx3AKlyttIPb7J+XykHvJP2B9bZDjlhLIoEq4XoK64Vg7boZlVWYK6LUY94dYPEE7Lh0ZkZKcQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-data-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-data-descriptor/-/is-data-descriptor-1.0.0.tgz", + "integrity": "sha512-jbRXy1FmtAoCjQkVmIVYwuuqDFUbaOeDjmed1tOGPrsMhtJA4rD9tkgA0F1qJ3gRFRXcHYVkdeaP50Q5rE/jLQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-descriptor": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-descriptor/-/is-descriptor-1.0.2.tgz", + "integrity": "sha512-2eis5WqQGV7peooDyLmNEPUrps9+SXX5c9pL3xEB+4e9HnGuDa7mB7kHxHw4CbqS9k1T2hOH3miL8n8WtiYVtg==", + "requires": { + "is-accessor-descriptor": "^1.0.0", + "is-data-descriptor": "^1.0.0", + "kind-of": "^6.0.2" + } + } + } + }, + "base64-js": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/base64-js/-/base64-js-1.5.1.tgz", + "integrity": "sha512-AKpaYlHn8t4SVbOHCy+b5+KKgvR4vrsD8vbvrbiQJps7fKDTkjkDry6ji0rUJjC0kzbNePLwzxq8iypo41qeWA==" + }, + "batch": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/batch/-/batch-0.6.1.tgz", + "integrity": "sha1-3DQxT05nkxgJP8dgJyUl+UvyXBY=" + }, + "bcrypt-pbkdf": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/bcrypt-pbkdf/-/bcrypt-pbkdf-1.0.2.tgz", + "integrity": "sha1-pDAdOJtqQ/m2f/PKEaP2Y342Dp4=", + "requires": { + "tweetnacl": "^0.14.3" + } + }, + "big-integer": { + "version": "1.6.48", + "resolved": "https://registry.npmjs.org/big-integer/-/big-integer-1.6.48.tgz", + "integrity": "sha512-j51egjPa7/i+RdiRuJbPdJ2FIUYYPhvYLjzoYbcMMm62ooO6F94fETG4MTs46zPAF9Brs04OajboA/qTGuz78w==" + }, + "big.js": { + "version": "5.2.2", + "resolved": "https://registry.npmjs.org/big.js/-/big.js-5.2.2.tgz", + "integrity": "sha512-vyL2OymJxmarO8gxMr0mhChsO9QGwhynfuu4+MHTAW6czfq9humCB7rKpUjDd9YUiDPU4mzpyupFSvOClAwbmQ==" + }, + "binary-extensions": { + "version": "1.13.1", + "resolved": "https://registry.npmjs.org/binary-extensions/-/binary-extensions-1.13.1.tgz", + "integrity": "sha512-Un7MIEDdUC5gNpcGDV97op1Ywk748MpHcFTHoYs6qnj1Z3j7I53VG3nwZhKzoBZmbdRNnb6WRdFlwl7tSDuZGw==" + }, + "bindings": { + "version": "1.5.0", + "resolved": "https://registry.npmjs.org/bindings/-/bindings-1.5.0.tgz", + "integrity": "sha512-p2q/t/mhvuOj/UeLlV6566GD/guowlr0hHxClI0W9m7MWYkL1F0hLo+0Aexs9HSPCtR1SXQ0TD3MMKrXZajbiQ==", + "requires": { + "file-uri-to-path": "1.0.0" + } + }, + "bluebird": { + "version": "3.7.2", + "resolved": "https://registry.npmjs.org/bluebird/-/bluebird-3.7.2.tgz", + "integrity": "sha512-XpNj6GDQzdfW+r2Wnn7xiSAd7TM3jzkxGXBGTtWKuSXv1xUV+azxAm8jdWZN06QTQk+2N2XB9jRDkvbmQmcRtg==" + }, + "bn.js": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-5.2.0.tgz", + "integrity": "sha512-D7iWRBvnZE8ecXiLj/9wbxH7Tk79fAh8IHaTNq1RWRixsS02W+5qS+iE9yq6RYl0asXx5tw0bLhmT5pIfbSquw==" + }, + "body-parser": { + "version": "1.19.0", + "resolved": "https://registry.npmjs.org/body-parser/-/body-parser-1.19.0.tgz", + "integrity": "sha512-dhEPs72UPbDnAQJ9ZKMNTP6ptJaionhP5cBb541nXPlW60Jepo9RV/a4fX4XWW9CuFNK22krhrj1+rgzifNCsw==", + "requires": { + "bytes": "3.1.0", + "content-type": "~1.0.4", + "debug": "2.6.9", + "depd": "~1.1.2", + "http-errors": "1.7.2", + "iconv-lite": "0.4.24", + "on-finished": "~2.3.0", + "qs": "6.7.0", + "raw-body": "2.4.0", + "type-is": "~1.6.17" + }, + "dependencies": { + "bytes": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/bytes/-/bytes-3.1.0.tgz", + "integrity": "sha512-zauLjrfCG+xvoyaqLoV8bLVXXNGC4JqlxFCutSDWA6fJrTo2ZuvLYTqZ7aHBLZSMOopbzwv8f+wZcVzfVTI2Dg==" + }, + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "http-errors": { + "version": "1.7.2", + "resolved": "https://registry.npmjs.org/http-errors/-/http-errors-1.7.2.tgz", + "integrity": "sha512-uUQBt3H/cSIVfch6i1EuPNy/YsRSOUBXTVfZ+yR7Zjez3qjBz6i9+i4zjNaoqcoFVI4lQJ5plg63TvGfRSDCRg==", + "requires": { + "depd": "~1.1.2", + "inherits": "2.0.3", + "setprototypeof": "1.1.1", + "statuses": ">= 1.5.0 < 2", + "toidentifier": "1.0.0" + } + }, + "inherits": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.3.tgz", + "integrity": "sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4=" + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + }, + "qs": { + "version": "6.7.0", + "resolved": "https://registry.npmjs.org/qs/-/qs-6.7.0.tgz", + "integrity": "sha512-VCdBRNFTX1fyE7Nb6FYoURo/SPe62QCaAyzJvUjwRaIsc+NePBEniHlvxFmmX56+HZphIGtV0XeCirBtpDrTyQ==" + } + } + }, + "bonjour": { + "version": "3.5.0", + "resolved": "https://registry.npmjs.org/bonjour/-/bonjour-3.5.0.tgz", + "integrity": "sha1-jokKGD2O6aI5OzhExpGkK897yfU=", + "requires": { + "array-flatten": "^2.1.0", + "deep-equal": "^1.0.1", + "dns-equal": "^1.0.0", + "dns-txt": "^2.0.2", + "multicast-dns": "^6.0.1", + "multicast-dns-service-types": "^1.1.0" + } + }, + "boolbase": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/boolbase/-/boolbase-1.0.0.tgz", + "integrity": "sha1-aN/1++YMUes3cl6p4+0xDcwed24=" + }, + "brace-expansion": { + "version": "1.1.11", + "resolved": "https://registry.npmjs.org/brace-expansion/-/brace-expansion-1.1.11.tgz", + "integrity": "sha512-iCuPHDFgrHX7H2vEI/5xpz07zSHB00TpugqhmYtVmMO6518mCuRMoOYFldEBl0g187ufozdaHgWKcYFb61qGiA==", + "requires": { + "balanced-match": "^1.0.0", + "concat-map": "0.0.1" + } + }, + "braces": { + "version": "2.3.2", + "resolved": "https://registry.npmjs.org/braces/-/braces-2.3.2.tgz", + "integrity": "sha512-aNdbnj9P8PjdXU4ybaWLK2IF3jc/EoDYbC7AazW6to3TRsfXxscC9UXOB5iDiEQrkyIbWp2SLQda4+QAa7nc3w==", + "requires": { + "arr-flatten": "^1.1.0", + "array-unique": "^0.3.2", + "extend-shallow": "^2.0.1", + "fill-range": "^4.0.0", + "isobject": "^3.0.1", + "repeat-element": "^1.1.2", + "snapdragon": "^0.8.1", + "snapdragon-node": "^2.0.1", + "split-string": "^3.0.2", + "to-regex": "^3.0.1" + }, + "dependencies": { + "extend-shallow": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz", + "integrity": "sha1-Ua99YUrZqfYQ6huvu5idaxxWiQ8=", + "requires": { + "is-extendable": "^0.1.0" + } + } + } + }, + "brfs": { + "version": "1.6.1", + "resolved": "https://registry.npmjs.org/brfs/-/brfs-1.6.1.tgz", + "integrity": "sha512-OfZpABRQQf+Xsmju8XE9bDjs+uU4vLREGolP7bDgcpsI17QREyZ4Bl+2KLxxx1kCgA0fAIhKQBaBYh+PEcCqYQ==", + "requires": { + "quote-stream": "^1.0.1", + "resolve": "^1.1.5", + "static-module": "^2.2.0", + "through2": "^2.0.0" + } + }, + "brorand": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/brorand/-/brorand-1.1.0.tgz", + "integrity": "sha1-EsJe/kCkXjwyPrhnWgoM5XsiNx8=" + }, + "browser-process-hrtime": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/browser-process-hrtime/-/browser-process-hrtime-1.0.0.tgz", + "integrity": "sha512-9o5UecI3GhkpM6DrXr69PblIuWxPKk9Y0jHBRhdocZ2y7YECBFCsHm79Pr3OyR2AvjhDkabFJaDJMYRazHgsow==" + }, + "browserify-aes": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/browserify-aes/-/browserify-aes-1.2.0.tgz", + "integrity": "sha512-+7CHXqGuspUn/Sl5aO7Ea0xWGAtETPXNSAjHo48JfLdPWcMng33Xe4znFvQweqc/uzk5zSOI3H52CYnjCfb5hA==", + "requires": { + "buffer-xor": "^1.0.3", + "cipher-base": "^1.0.0", + "create-hash": "^1.1.0", + "evp_bytestokey": "^1.0.3", + "inherits": "^2.0.1", + "safe-buffer": "^5.0.1" + } + }, + "browserify-cipher": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/browserify-cipher/-/browserify-cipher-1.0.1.tgz", + "integrity": "sha512-sPhkz0ARKbf4rRQt2hTpAHqn47X3llLkUGn+xEJzLjwY8LRs2p0v7ljvI5EyoRO/mexrNunNECisZs+gw2zz1w==", + "requires": { + "browserify-aes": "^1.0.4", + "browserify-des": "^1.0.0", + "evp_bytestokey": "^1.0.0" + } + }, + "browserify-des": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/browserify-des/-/browserify-des-1.0.2.tgz", + "integrity": "sha512-BioO1xf3hFwz4kc6iBhI3ieDFompMhrMlnDFC4/0/vd5MokpuAc3R+LYbwTA9A5Yc9pq9UYPqffKpW2ObuwX5A==", + "requires": { + "cipher-base": "^1.0.1", + "des.js": "^1.0.0", + "inherits": "^2.0.1", + "safe-buffer": "^5.1.2" + } + }, + "browserify-rsa": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/browserify-rsa/-/browserify-rsa-4.1.0.tgz", + "integrity": "sha512-AdEER0Hkspgno2aR97SAf6vi0y0k8NuOpGnVH3O99rcA5Q6sh8QxcngtHuJ6uXwnfAXNM4Gn1Gb7/MV1+Ymbog==", + "requires": { + "bn.js": "^5.0.0", + "randombytes": "^2.0.1" + } + }, + "browserify-sign": { + "version": "4.2.1", + "resolved": "https://registry.npmjs.org/browserify-sign/-/browserify-sign-4.2.1.tgz", + "integrity": "sha512-/vrA5fguVAKKAVTNJjgSm1tRQDHUU6DbwO9IROu/0WAzC8PKhucDSh18J0RMvVeHAn5puMd+QHC2erPRNf8lmg==", + "requires": { + "bn.js": "^5.1.1", + "browserify-rsa": "^4.0.1", + "create-hash": "^1.2.0", + "create-hmac": "^1.1.7", + "elliptic": "^6.5.3", + "inherits": "^2.0.4", + "parse-asn1": "^5.1.5", + "readable-stream": "^3.6.0", + "safe-buffer": "^5.2.0" + }, + "dependencies": { + "readable-stream": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", + "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "requires": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + } + }, + "safe-buffer": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz", + "integrity": "sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ==" + } + } + }, + "browserify-zlib": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/browserify-zlib/-/browserify-zlib-0.2.0.tgz", + "integrity": "sha512-Z942RysHXmJrhqk88FmKBVq/v5tqmSkDz7p54G/MGyjMnCFFnC79XWNbg+Vta8W6Wb2qtSZTSxIGkJrRpCFEiA==", + "requires": { + "pako": "~1.0.5" + }, + "dependencies": { + "pako": { + "version": "1.0.11", + "resolved": "https://registry.npmjs.org/pako/-/pako-1.0.11.tgz", + "integrity": "sha512-4hLB8Py4zZce5s4yd9XzopqwVv/yGNhV1Bl8NTmCq1763HeK2+EwVTv+leGeL13Dnh2wfbqowVPXCIO0z4taYw==" + } + } + }, + "browserslist": { + "version": "4.16.6", + "resolved": "https://registry.npmjs.org/browserslist/-/browserslist-4.16.6.tgz", + "integrity": "sha512-Wspk/PqO+4W9qp5iUTJsa1B/QrYn1keNCcEP5OvP7WBwT4KaDly0uONYmC6Xa3Z5IqnUgS0KcgLYu1l74x0ZXQ==", + "requires": { + "caniuse-lite": "^1.0.30001219", + "colorette": "^1.2.2", + "electron-to-chromium": "^1.3.723", + "escalade": "^3.1.1", + "node-releases": "^1.1.71" + } + }, + "buffer": { + "version": "4.9.2", + "resolved": "https://registry.npmjs.org/buffer/-/buffer-4.9.2.tgz", + "integrity": "sha512-xq+q3SRMOxGivLhBNaUdC64hDTQwejJ+H0T/NB1XMtTVEwNTrfFF3gAxiyW0Bu/xWEGhjVKgUcMhCrUy2+uCWg==", + "requires": { + "base64-js": "^1.0.2", + "ieee754": "^1.1.4", + "isarray": "^1.0.0" + } + }, + "buffer-equal": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/buffer-equal/-/buffer-equal-0.0.1.tgz", + "integrity": "sha1-kbx0sR6kBbyRa8aqkI+q+ltKrEs=" + }, + "buffer-from": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/buffer-from/-/buffer-from-1.1.1.tgz", + "integrity": "sha512-MQcXEUbCKtEo7bhqEs6560Hyd4XaovZlO/k9V3hjVUF/zwW7KBVdSK4gIt/bzwS9MbR5qob+F5jusZsb0YQK2A==" + }, + "buffer-indexof": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/buffer-indexof/-/buffer-indexof-1.1.1.tgz", + "integrity": "sha512-4/rOEg86jivtPTeOUUT61jJO1Ya1TrR/OkqCSZDyq84WJh3LuuiphBYJN+fm5xufIk4XAFcEwte/8WzC8If/1g==" + }, + "buffer-xor": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/buffer-xor/-/buffer-xor-1.0.3.tgz", + "integrity": "sha1-JuYe0UIvtw3ULm42cp7VHYVf6Nk=" + }, + "builtin-status-codes": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/builtin-status-codes/-/builtin-status-codes-3.0.0.tgz", + "integrity": "sha1-hZgoeOIbmOHGZCXgPQF0eI9Wnug=" + }, + "byline": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/byline/-/byline-5.0.0.tgz", + "integrity": "sha1-dBxSFkaOrcRXsDQQEYrXfejB3bE=" + }, + "bytes": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/bytes/-/bytes-3.0.0.tgz", + "integrity": "sha1-0ygVQE1olpn4Wk6k+odV3ROpYEg=" + }, + "cacache": { + "version": "11.3.3", + "resolved": "https://registry.npmjs.org/cacache/-/cacache-11.3.3.tgz", + "integrity": "sha512-p8WcneCytvzPxhDvYp31PD039vi77I12W+/KfR9S8AZbaiARFBCpsPJS+9uhWfeBfeAtW7o/4vt3MUqLkbY6nA==", + "requires": { + "bluebird": "^3.5.5", + "chownr": "^1.1.1", + "figgy-pudding": "^3.5.1", + "glob": "^7.1.4", + "graceful-fs": "^4.1.15", + "lru-cache": "^5.1.1", + "mississippi": "^3.0.0", + "mkdirp": "^0.5.1", + "move-concurrently": "^1.0.1", + "promise-inflight": "^1.0.1", + "rimraf": "^2.6.3", + "ssri": "^6.0.1", + "unique-filename": "^1.1.1", + "y18n": "^4.0.0" + }, + "dependencies": { + "lru-cache": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-5.1.1.tgz", + "integrity": "sha512-KpNARQA3Iwv+jTA0utUVVbrh+Jlrr1Fv0e56GGzAFOXN7dk/FviaDW8LHmK52DlcH4WP2n6gI8vN1aesBFgo9w==", + "requires": { + "yallist": "^3.0.2" + } + }, + "yallist": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/yallist/-/yallist-3.1.1.tgz", + "integrity": "sha512-a4UGQaWPH59mOXUYnAG2ewncQS4i4F43Tv3JoAM+s2VDAmS9NsK8GpDMLrCHPksFT7h3K6TOoUNn2pb7RoXx4g==" + } + } + }, + "cache-base": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/cache-base/-/cache-base-1.0.1.tgz", + "integrity": "sha512-AKcdTnFSWATd5/GCPRxr2ChwIJ85CeyrEyjRHlKxQ56d4XJMGym0uAiKn0xbLOGOl3+yRpOTi484dVCEc5AUzQ==", + "requires": { + "collection-visit": "^1.0.0", + "component-emitter": "^1.2.1", + "get-value": "^2.0.6", + "has-value": "^1.0.0", + "isobject": "^3.0.1", + "set-value": "^2.0.0", + "to-object-path": "^0.3.0", + "union-value": "^1.0.0", + "unset-value": "^1.0.0" + } + }, + "call-bind": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/call-bind/-/call-bind-1.0.2.tgz", + "integrity": "sha512-7O+FbCihrB5WGbFYesctwmTKae6rOiIzmz1icreWJ+0aA7LJfuqhEso2T9ncpcFtzMQtzXf2QGGueWJGTYsqrA==", + "requires": { + "function-bind": "^1.1.1", + "get-intrinsic": "^1.0.2" + } + }, + "call-me-maybe": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/call-me-maybe/-/call-me-maybe-1.0.1.tgz", + "integrity": "sha1-JtII6onje1y95gJQoV8DHBak1ms=" + }, + "caller-callsite": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/caller-callsite/-/caller-callsite-2.0.0.tgz", + "integrity": "sha1-hH4PzgoiN1CpoCfFSzNzGtMVQTQ=", + "requires": { + "callsites": "^2.0.0" + } + }, + "caller-path": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/caller-path/-/caller-path-2.0.0.tgz", + "integrity": "sha1-Ro+DBE42mrIBD6xfBs7uFbsssfQ=", + "requires": { + "caller-callsite": "^2.0.0" + } + }, + "callsites": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/callsites/-/callsites-2.0.0.tgz", + "integrity": "sha1-BuuE8A7qQT2oav/vrL/7Ngk7PFA=" + }, + "camel-case": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/camel-case/-/camel-case-4.1.2.tgz", + "integrity": "sha512-gxGWBrTT1JuMx6R+o5PTXMmUnhnVzLQ9SNutD4YqKtI6ap897t3tKECYla6gCWEkplXnlNybEkZg9GEGxKFCgw==", + "requires": { + "pascal-case": "^3.1.2", + "tslib": "^2.0.3" + } + }, + "camelcase": { + "version": "5.3.1", + "resolved": "https://registry.npmjs.org/camelcase/-/camelcase-5.3.1.tgz", + "integrity": "sha512-L28STB170nwWS63UjtlEOE3dldQApaJXZkOI1uMFfzf3rRuPegHaHesyee+YxQ+W6SvRDQV6UrdOdRiR153wJg==" + }, + "caniuse-api": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/caniuse-api/-/caniuse-api-3.0.0.tgz", + "integrity": "sha512-bsTwuIg/BZZK/vreVTYYbSWoe2F+71P7K5QGEX+pT250DZbfU1MQ5prOKpPR+LL6uWKK3KMwMCAS74QB3Um1uw==", + "requires": { + "browserslist": "^4.0.0", + "caniuse-lite": "^1.0.0", + "lodash.memoize": "^4.1.2", + "lodash.uniq": "^4.5.0" + } + }, + "caniuse-lite": { + "version": "1.0.30001240", + "resolved": "https://registry.npmjs.org/caniuse-lite/-/caniuse-lite-1.0.30001240.tgz", + "integrity": "sha512-nb8mDzfMdxBDN7ZKx8chWafAdBp5DAAlpWvNyUGe5tcDWd838zpzDN3Rah9cjCqhfOKkrvx40G2SDtP0qiWX/w==" + }, + "caseless": { + "version": "0.12.0", + "resolved": "https://registry.npmjs.org/caseless/-/caseless-0.12.0.tgz", + "integrity": "sha1-G2gcIf+EAzyCZUMJBolCDRhxUdw=" + }, + "chalk": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-2.4.2.tgz", + "integrity": "sha512-Mti+f9lpJNcwF4tWV8/OrTTtF1gZi+f8FqlyAdouralcFWFQWF2+NgCHShjkCb+IFBLq9buZwE1xckQU4peSuQ==", + "requires": { + "ansi-styles": "^3.2.1", + "escape-string-regexp": "^1.0.5", + "supports-color": "^5.3.0" + } + }, + "chokidar": { + "version": "2.1.8", + "resolved": "https://registry.npmjs.org/chokidar/-/chokidar-2.1.8.tgz", + "integrity": "sha512-ZmZUazfOzf0Nve7duiCKD23PFSCs4JPoYyccjUFF3aQkQadqBhfzhjkwBH2mNOG9cTBwhamM37EIsIkZw3nRgg==", + "requires": { + "anymatch": "^2.0.0", + "async-each": "^1.0.1", + "braces": "^2.3.2", + "fsevents": "^1.2.7", + "glob-parent": "^3.1.0", + "inherits": "^2.0.3", + "is-binary-path": "^1.0.0", + "is-glob": "^4.0.0", + "normalize-path": "^3.0.0", + "path-is-absolute": "^1.0.0", + "readdirp": "^2.2.1", + "upath": "^1.1.1" + } + }, + "chownr": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/chownr/-/chownr-1.1.4.tgz", + "integrity": "sha512-jJ0bqzaylmJtVnNgzTeSOs8DPavpbYgEr/b0YL8/2GO3xJEhInFmhKMUnEJQjZumK7KXGFhUy89PrsJWlakBVg==" + }, + "chrome-trace-event": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/chrome-trace-event/-/chrome-trace-event-1.0.3.tgz", + "integrity": "sha512-p3KULyQg4S7NIHixdwbGX+nFHkoBiA4YQmyWtjb8XngSKV124nJmRysgAeujbUVb15vh+RvFUfCPqU7rXk+hZg==" + }, + "cipher-base": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/cipher-base/-/cipher-base-1.0.4.tgz", + "integrity": "sha512-Kkht5ye6ZGmwv40uUDZztayT2ThLQGfnj/T71N/XzeZeo3nf8foyW7zGTsPYkEya3m5f3cAypH+qe7YOrM1U2Q==", + "requires": { + "inherits": "^2.0.1", + "safe-buffer": "^5.0.1" + } + }, + "class-utils": { + "version": "0.3.6", + "resolved": "https://registry.npmjs.org/class-utils/-/class-utils-0.3.6.tgz", + "integrity": "sha512-qOhPa/Fj7s6TY8H8esGu5QNpMMQxz79h+urzrNYN6mn+9BnxlDGf5QZ+XeCDsxSjPqsSR56XOZOJmpeurnLMeg==", + "requires": { + "arr-union": "^3.1.0", + "define-property": "^0.2.5", + "isobject": "^3.0.0", + "static-extend": "^0.1.1" + }, + "dependencies": { + "define-property": { + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-0.2.5.tgz", + "integrity": "sha1-w1se+RjsPJkPmlvFe+BKrOxcgRY=", + "requires": { + "is-descriptor": "^0.1.0" + } + } + } + }, + "clean-css": { + "version": "4.2.3", + "resolved": "https://registry.npmjs.org/clean-css/-/clean-css-4.2.3.tgz", + "integrity": "sha512-VcMWDN54ZN/DS+g58HYL5/n4Zrqe8vHJpGA8KdgUXFU4fuP/aHNw8eld9SyEIyabIMJX/0RaY/fplOo5hYLSFA==", + "requires": { + "source-map": "~0.6.0" + } + }, + "cli-cursor": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/cli-cursor/-/cli-cursor-2.1.0.tgz", + "integrity": "sha1-s12sN2R5+sw+lHR9QdDQ9SOP/LU=", + "requires": { + "restore-cursor": "^2.0.0" + } + }, + "cli-spinners": { + "version": "1.3.1", + "resolved": "https://registry.npmjs.org/cli-spinners/-/cli-spinners-1.3.1.tgz", + "integrity": "sha512-1QL4544moEsDVH9T/l6Cemov/37iv1RtoKf7NJ04A60+4MREXNfx/QvavbH6QoGdsD4N4Mwy49cmaINR/o2mdg==" + }, + "cliui": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/cliui/-/cliui-5.0.0.tgz", + "integrity": "sha512-PYeGSEmmHM6zvoef2w8TPzlrnNpXIjTipYK780YswmIP9vjxmd6Y2a3CB2Ks6/AU8NHjZugXvo8w3oWM2qnwXA==", + "requires": { + "string-width": "^3.1.0", + "strip-ansi": "^5.2.0", + "wrap-ansi": "^5.1.0" + }, + "dependencies": { + "ansi-regex": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-4.1.0.tgz", + "integrity": "sha512-1apePfXM1UOSqw0o9IiFAovVz9M5S1Dg+4TrDwfMewQ6p/rmMueb7tWZjQ1rx4Loy1ArBggoqGpfqqdI4rondg==" + }, + "strip-ansi": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-5.2.0.tgz", + "integrity": "sha512-DuRs1gKbBqsMKIZlrffwlug8MHkcnpjs5VPmL1PAh+mA30U0DTotfDZ0d2UUsXpPmPmMMJ6W773MaA3J+lbiWA==", + "requires": { + "ansi-regex": "^4.1.0" + } + } + } + }, + "clone": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/clone/-/clone-2.1.2.tgz", + "integrity": "sha1-G39Ln1kfHo+DZwQBYANFoCiHQ18=" + }, + "clone-deep": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/clone-deep/-/clone-deep-4.0.1.tgz", + "integrity": "sha512-neHB9xuzh/wk0dIHweyAXv2aPGZIVk3pLMe+/RNzINf17fe0OG96QroktYAUm7SM1PBnzTabaLboqqxDyMU+SQ==", + "requires": { + "is-plain-object": "^2.0.4", + "kind-of": "^6.0.2", + "shallow-clone": "^3.0.0" + } + }, + "clones": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/clones/-/clones-1.2.0.tgz", + "integrity": "sha512-FXDYw4TjR8wgPZYui2LeTqWh1BLpfQ8lB6upMtlpDF6WlOOxghmTTxWyngdKTgozqBgKnHbTVwTE+hOHqAykuQ==" + }, + "coa": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/coa/-/coa-2.0.2.tgz", + "integrity": "sha512-q5/jG+YQnSy4nRTV4F7lPepBJZ8qBNJJDBuJdoejDyLXgmL7IEo+Le2JDZudFTFt7mrCqIRaSjws4ygRCTCAXA==", + "requires": { + "@types/q": "^1.5.1", + "chalk": "^2.4.1", + "q": "^1.1.2" + } + }, + "collection-visit": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/collection-visit/-/collection-visit-1.0.0.tgz", + "integrity": "sha1-S8A3PBZLwykbTTaMgpzxqApZ3KA=", + "requires": { + "map-visit": "^1.0.0", + "object-visit": "^1.0.0" + } + }, + "color": { + "version": "3.1.3", + "resolved": "https://registry.npmjs.org/color/-/color-3.1.3.tgz", + "integrity": "sha512-xgXAcTHa2HeFCGLE9Xs/R82hujGtu9Jd9x4NW3T34+OMs7VoPsjwzRczKHvTAHeJwWFwX5j15+MgAppE8ztObQ==", + "requires": { + "color-convert": "^1.9.1", + "color-string": "^1.5.4" + } + }, + "color-convert": { + "version": "1.9.3", + "resolved": "https://registry.npmjs.org/color-convert/-/color-convert-1.9.3.tgz", + "integrity": "sha512-QfAUtd+vFdAtFQcC8CCyYt1fYWxSqAiK2cSD6zDB8N3cpsEBAvRxp9zOGg6G/SHHJYAT88/az/IuDGALsNVbGg==", + "requires": { + "color-name": "1.1.3" + } + }, + "color-name": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/color-name/-/color-name-1.1.3.tgz", + "integrity": "sha1-p9BVi9icQveV3UIyj3QIMcpTvCU=" + }, + "color-string": { + "version": "1.5.5", + "resolved": "https://registry.npmjs.org/color-string/-/color-string-1.5.5.tgz", + "integrity": "sha512-jgIoum0OfQfq9Whcfc2z/VhCNcmQjWbey6qBX0vqt7YICflUmBCh9E9CiQD5GSJ+Uehixm3NUwHVhqUAWRivZg==", + "requires": { + "color-name": "^1.0.0", + "simple-swizzle": "^0.2.2" + } + }, + "colorette": { + "version": "1.2.2", + "resolved": "https://registry.npmjs.org/colorette/-/colorette-1.2.2.tgz", + "integrity": "sha512-MKGMzyfeuutC/ZJ1cba9NqcNpfeqMUcYmyF1ZFY6/Cn7CNSAKx6a+s48sqLqyAiZuaP2TcqMhoo+dlwFnVxT9w==" + }, + "combined-stream": { + "version": "1.0.8", + "resolved": "https://registry.npmjs.org/combined-stream/-/combined-stream-1.0.8.tgz", + "integrity": "sha512-FQN4MRfuJeHf7cBbBMJFXhKSDq+2kAArBlmRBvcvFE5BB1HZKXtSFASDhdlz9zOYwxh8lDdnvmMOe/+5cdoEdg==", + "requires": { + "delayed-stream": "~1.0.0" + } + }, + "command-exists": { + "version": "1.2.9", + "resolved": "https://registry.npmjs.org/command-exists/-/command-exists-1.2.9.tgz", + "integrity": "sha512-LTQ/SGc+s0Xc0Fu5WaKnR0YiygZkm9eKFvyS+fRsU7/ZWFF8ykFM6Pc9aCVf1+xasOOZpO3BAVgVrKvsqKHV7w==" + }, + "commander": { + "version": "2.20.3", + "resolved": "https://registry.npmjs.org/commander/-/commander-2.20.3.tgz", + "integrity": "sha512-GpVkmM8vF2vQUkj2LvZmD35JxeJOLCwJ9cUkugyk2nuhbv3+mJvpLYYt+0+USMxE+oj+ey/lJEnhZw75x/OMcQ==" + }, + "component-emitter": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/component-emitter/-/component-emitter-1.3.0.tgz", + "integrity": "sha512-Rd3se6QB+sO1TwqZjscQrurpEPIfO0/yYnSin6Q/rD3mOutHvUrCAhJub3r90uNb+SESBuE0QYoB90YdfatsRg==" + }, + "compressible": { + "version": "2.0.18", + "resolved": "https://registry.npmjs.org/compressible/-/compressible-2.0.18.tgz", + "integrity": "sha512-AF3r7P5dWxL8MxyITRMlORQNaOA2IkAFaTr4k7BUumjPtRpGDTZpl0Pb1XCO6JeDCBdp126Cgs9sMxqSjgYyRg==", + "requires": { + "mime-db": ">= 1.43.0 < 2" + } + }, + "compression": { + "version": "1.7.4", + "resolved": "https://registry.npmjs.org/compression/-/compression-1.7.4.tgz", + "integrity": "sha512-jaSIDzP9pZVS4ZfQ+TzvtiWhdpFhE2RDHz8QJkpX9SIpLq88VueF5jJw6t+6CUQcAoA6t+x89MLrWAqpfDE8iQ==", + "requires": { + "accepts": "~1.3.5", + "bytes": "3.0.0", + "compressible": "~2.0.16", + "debug": "2.6.9", + "on-headers": "~1.0.2", + "safe-buffer": "5.1.2", + "vary": "~1.1.2" + }, + "dependencies": { + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + } + } + }, + "concat-map": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/concat-map/-/concat-map-0.0.1.tgz", + "integrity": "sha1-2Klr13/Wjfd5OnMDajug1UBdR3s=" + }, + "concat-stream": { + "version": "1.6.2", + "resolved": "https://registry.npmjs.org/concat-stream/-/concat-stream-1.6.2.tgz", + "integrity": "sha512-27HBghJxjiZtIk3Ycvn/4kbJk/1uZuJFfuPEns6LaEvpvG1f0hTea8lilrouyo9mVc2GWdcEZ8OLoGmSADlrCw==", + "requires": { + "buffer-from": "^1.0.0", + "inherits": "^2.0.3", + "readable-stream": "^2.2.2", + "typedarray": "^0.0.6" + } + }, + "config-chain": { + "version": "1.1.13", + "resolved": "https://registry.npmjs.org/config-chain/-/config-chain-1.1.13.tgz", + "integrity": "sha512-qj+f8APARXHrM0hraqXYb2/bOVSV4PvJQlNZ/DVj0QrmNM2q2euizkeuVckQ57J+W0mRH6Hvi+k50M4Jul2VRQ==", + "requires": { + "ini": "^1.3.4", + "proto-list": "~1.2.1" + } + }, + "connect-history-api-fallback": { + "version": "1.6.0", + "resolved": "https://registry.npmjs.org/connect-history-api-fallback/-/connect-history-api-fallback-1.6.0.tgz", + "integrity": "sha512-e54B99q/OUoH64zYYRf3HBP5z24G38h5D3qXu23JGRoigpX5Ss4r9ZnDk3g0Z8uQC2x2lPaJ+UlWBc1ZWBWdLg==" + }, + "console-browserify": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/console-browserify/-/console-browserify-1.2.0.tgz", + "integrity": "sha512-ZMkYO/LkF17QvCPqM0gxw8yUzigAOZOSWSHg91FH6orS7vcEj5dVZTidN2fQ14yBSdg97RqhSNwLUXInd52OTA==" + }, + "constants-browserify": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/constants-browserify/-/constants-browserify-1.0.0.tgz", + "integrity": "sha1-wguW2MYXdIqvHBYCF2DNJ/y4y3U=" + }, + "content-disposition": { + "version": "0.5.3", + "resolved": "https://registry.npmjs.org/content-disposition/-/content-disposition-0.5.3.tgz", + "integrity": "sha512-ExO0774ikEObIAEV9kDo50o+79VCUdEB6n6lzKgGwupcVeRlhrj3qGAfwq8G6uBJjkqLrhT0qEYFcWng8z1z0g==", + "requires": { + "safe-buffer": "5.1.2" + } + }, + "content-type": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/content-type/-/content-type-1.0.4.tgz", + "integrity": "sha512-hIP3EEPs8tB9AT1L+NUqtwOAps4mk2Zob89MWXMHjHWg9milF/j4osnnQLXBCBFBk/tvIG/tUc9mOUJiPBhPXA==" + }, + "convert-source-map": { + "version": "1.8.0", + "resolved": "https://registry.npmjs.org/convert-source-map/-/convert-source-map-1.8.0.tgz", + "integrity": "sha512-+OQdjP49zViI/6i7nIJpA8rAl4sV/JdPfU9nZs3VqOwGIgizICvuN2ru6fMd+4llL0tar18UYJXfZ/TWtmhUjA==", + "requires": { + "safe-buffer": "~5.1.1" + } + }, + "cookie": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/cookie/-/cookie-0.4.0.tgz", + "integrity": "sha512-+Hp8fLp57wnUSt0tY0tHEXh4voZRDnoIrZPqlo3DPiI4y9lwg/jqx+1Om94/W6ZaPDOUbnjOt/99w66zk+l1Xg==" + }, + "cookie-signature": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.0.6.tgz", + "integrity": "sha1-4wOogrNCzD7oylE6eZmXNNqzriw=" + }, + "copy-concurrently": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/copy-concurrently/-/copy-concurrently-1.0.5.tgz", + "integrity": "sha512-f2domd9fsVDFtaFcbaRZuYXwtdmnzqbADSwhSWYxYB/Q8zsdUUFMXVRwXGDMWmbEzAn1kdRrtI1T/KTFOL4X2A==", + "requires": { + "aproba": "^1.1.1", + "fs-write-stream-atomic": "^1.0.8", + "iferr": "^0.1.5", + "mkdirp": "^0.5.1", + "rimraf": "^2.5.4", + "run-queue": "^1.0.0" + } + }, + "copy-descriptor": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/copy-descriptor/-/copy-descriptor-0.1.1.tgz", + "integrity": "sha1-Z29us8OZl8LuGsOpJP1hJHSPV40=" + }, + "core-js": { + "version": "2.6.12", + "resolved": "https://registry.npmjs.org/core-js/-/core-js-2.6.12.tgz", + "integrity": "sha512-Kb2wC0fvsWfQrgk8HU5lW6U/Lcs8+9aaYcy4ZFc6DDlo4nZ7n70dEgE5rtR0oG6ufKDUnrwfWL1mXR5ljDatrQ==" + }, + "core-util-is": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/core-util-is/-/core-util-is-1.0.2.tgz", + "integrity": "sha1-tf1UIgqivFq1eqtxQMlAdUUDwac=" + }, + "cors-anywhere": { + "version": "0.4.4", + "resolved": "https://registry.npmjs.org/cors-anywhere/-/cors-anywhere-0.4.4.tgz", + "integrity": "sha512-8OBFwnzMgR4mNrAeAyOLB2EruS2z7u02of2bOu7i9kKYlZG+niS7CTHLPgEXKWW2NAOJWRry9RRCaL9lJRjNqg==", + "requires": { + "http-proxy": "1.11.1", + "proxy-from-env": "0.0.1" + } + }, + "cosmiconfig": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/cosmiconfig/-/cosmiconfig-5.2.1.tgz", + "integrity": "sha512-H65gsXo1SKjf8zmrJ67eJk8aIRKV5ff2D4uKZIBZShbhGSpEmsQOPW/SKMKYhSTrqR7ufy6RP69rPogdaPh/kA==", + "requires": { + "import-fresh": "^2.0.0", + "is-directory": "^0.3.1", + "js-yaml": "^3.13.1", + "parse-json": "^4.0.0" + } + }, + "create-ecdh": { + "version": "4.0.4", + "resolved": "https://registry.npmjs.org/create-ecdh/-/create-ecdh-4.0.4.tgz", + "integrity": "sha512-mf+TCx8wWc9VpuxfP2ht0iSISLZnt0JgWlrOKZiNqyUZWnjIaCIVNQArMHnCZKfEYRg6IM7A+NeJoN8gf/Ws0A==", + "requires": { + "bn.js": "^4.1.0", + "elliptic": "^6.5.3" + }, + "dependencies": { + "bn.js": { + "version": "4.12.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.0.tgz", + "integrity": "sha512-c98Bf3tPniI+scsdk237ku1Dc3ujXQTSgyiPUDEOe7tRkhrqridvh8klBv0HCEso1OLOYcHuCv/cS6DNxKH+ZA==" + } + } + }, + "create-hash": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/create-hash/-/create-hash-1.2.0.tgz", + "integrity": "sha512-z00bCGNHDG8mHAkP7CtT1qVu+bFQUPjYq/4Iv3C3kWjTFV10zIjfSoeqXo9Asws8gwSHDGj/hl2u4OGIjapeCg==", + "requires": { + "cipher-base": "^1.0.1", + "inherits": "^2.0.1", + "md5.js": "^1.3.4", + "ripemd160": "^2.0.1", + "sha.js": "^2.4.0" + } + }, + "create-hmac": { + "version": "1.1.7", + "resolved": "https://registry.npmjs.org/create-hmac/-/create-hmac-1.1.7.tgz", + "integrity": "sha512-MJG9liiZ+ogc4TzUwuvbER1JRdgvUFSB5+VR/g5h82fGaIRWMWddtKBHi7/sVhfjQZ6SehlyhvQYrcYkaUIpLg==", + "requires": { + "cipher-base": "^1.0.3", + "create-hash": "^1.1.0", + "inherits": "^2.0.1", + "ripemd160": "^2.0.0", + "safe-buffer": "^5.0.1", + "sha.js": "^2.4.8" + } + }, + "cross-spawn": { + "version": "6.0.5", + "resolved": "https://registry.npmjs.org/cross-spawn/-/cross-spawn-6.0.5.tgz", + "integrity": "sha512-eTVLrBSt7fjbDygz805pMnstIs2VTBNkRm0qxZd+M7A5XDdxVRWO5MxGBXZhjY4cqLYLdtrGqRf8mBPmzwSpWQ==", + "requires": { + "nice-try": "^1.0.4", + "path-key": "^2.0.1", + "semver": "^5.5.0", + "shebang-command": "^1.2.0", + "which": "^1.2.9" + } + }, + "crypto-browserify": { + "version": "3.12.0", + "resolved": "https://registry.npmjs.org/crypto-browserify/-/crypto-browserify-3.12.0.tgz", + "integrity": "sha512-fz4spIh+znjO2VjL+IdhEpRJ3YN6sMzITSBijk6FK2UvTqruSQW+/cCZTSNsMiZNvUeq0CqurF+dAbyiGOY6Wg==", + "requires": { + "browserify-cipher": "^1.0.0", + "browserify-sign": "^4.0.0", + "create-ecdh": "^4.0.0", + "create-hash": "^1.1.0", + "create-hmac": "^1.1.0", + "diffie-hellman": "^5.0.0", + "inherits": "^2.0.1", + "pbkdf2": "^3.0.3", + "public-encrypt": "^4.0.0", + "randombytes": "^2.0.0", + "randomfill": "^1.0.3" + } + }, + "css-color-names": { + "version": "0.0.4", + "resolved": "https://registry.npmjs.org/css-color-names/-/css-color-names-0.0.4.tgz", + "integrity": "sha1-gIrcLnnPhHOAabZGyyDsJ762KeA=" + }, + "css-declaration-sorter": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/css-declaration-sorter/-/css-declaration-sorter-4.0.1.tgz", + "integrity": "sha512-BcxQSKTSEEQUftYpBVnsH4SF05NTuBokb19/sBt6asXGKZ/6VP7PLG1CBCkFDYOnhXhPh0jMhO6xZ71oYHXHBA==", + "requires": { + "postcss": "^7.0.1", + "timsort": "^0.3.0" + } + }, + "css-modules-loader-core": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/css-modules-loader-core/-/css-modules-loader-core-1.1.0.tgz", + "integrity": "sha1-WQhmgpShvs0mGuCkziGwtVHyHRY=", + "requires": { + "icss-replace-symbols": "1.1.0", + "postcss": "6.0.1", + "postcss-modules-extract-imports": "1.1.0", + "postcss-modules-local-by-default": "1.2.0", + "postcss-modules-scope": "1.1.0", + "postcss-modules-values": "1.3.0" + }, + "dependencies": { + "ansi-regex": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", + "integrity": "sha1-w7M6te42DYbg5ijwRorn7yfWVN8=" + }, + "ansi-styles": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-2.2.1.tgz", + "integrity": "sha1-tDLdM1i2NM914eRmQ2gkBTPB3b4=" + }, + "chalk": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-1.1.3.tgz", + "integrity": "sha1-qBFcVeSnAv5NFQq9OHKCKn4J/Jg=", + "requires": { + "ansi-styles": "^2.2.1", + "escape-string-regexp": "^1.0.2", + "has-ansi": "^2.0.0", + "strip-ansi": "^3.0.0", + "supports-color": "^2.0.0" + }, + "dependencies": { + "supports-color": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-2.0.0.tgz", + "integrity": "sha1-U10EXOa2Nj+kARcIRimZXp3zJMc=" + } + } + }, + "has-flag": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-1.0.0.tgz", + "integrity": "sha1-nZ55MWXOAXoA8AQYxD+UKnsdEfo=" + }, + "postcss": { + "version": "6.0.1", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-6.0.1.tgz", + "integrity": "sha1-AA29H47vIXqjaLmiEsX8QLKo8/I=", + "requires": { + "chalk": "^1.1.3", + "source-map": "^0.5.6", + "supports-color": "^3.2.3" + } + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + }, + "strip-ansi": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-3.0.1.tgz", + "integrity": "sha1-ajhfuIU9lS1f8F0Oiq+UJ43GPc8=", + "requires": { + "ansi-regex": "^2.0.0" + } + }, + "supports-color": { + "version": "3.2.3", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-3.2.3.tgz", + "integrity": "sha1-ZawFBLOVQXHYpklGsq48u4pfVPY=", + "requires": { + "has-flag": "^1.0.0" + } + } + } + }, + "css-select": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-2.1.0.tgz", + "integrity": "sha512-Dqk7LQKpwLoH3VovzZnkzegqNSuAziQyNZUcrdDM401iY+R5NkGBXGmtO05/yaXQziALuPogeG0b7UAgjnTJTQ==", + "requires": { + "boolbase": "^1.0.0", + "css-what": "^3.2.1", + "domutils": "^1.7.0", + "nth-check": "^1.0.2" + } + }, + "css-select-base-adapter": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/css-select-base-adapter/-/css-select-base-adapter-0.1.1.tgz", + "integrity": "sha512-jQVeeRG70QI08vSTwf1jHxp74JoZsr2XSgETae8/xC8ovSnL2WF87GTLO86Sbwdt2lK4Umg4HnnwMO4YF3Ce7w==" + }, + "css-selector-tokenizer": { + "version": "0.7.3", + "resolved": "https://registry.npmjs.org/css-selector-tokenizer/-/css-selector-tokenizer-0.7.3.tgz", + "integrity": "sha512-jWQv3oCEL5kMErj4wRnK/OPoBi0D+P1FR2cDCKYPaMeD2eW3/mttav8HT4hT1CKopiJI/psEULjkClhvJo4Lvg==", + "requires": { + "cssesc": "^3.0.0", + "fastparse": "^1.1.2" + } + }, + "css-tree": { + "version": "1.0.0-alpha.37", + "resolved": "https://registry.npmjs.org/css-tree/-/css-tree-1.0.0-alpha.37.tgz", + "integrity": "sha512-DMxWJg0rnz7UgxKT0Q1HU/L9BeJI0M6ksor0OgqOnF+aRCDWg/N2641HmVyU9KVIu0OVVWOb2IpC9A+BJRnejg==", + "requires": { + "mdn-data": "2.0.4", + "source-map": "^0.6.1" + } + }, + "css-what": { + "version": "3.4.2", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-3.4.2.tgz", + "integrity": "sha512-ACUm3L0/jiZTqfzRM3Hi9Q8eZqd6IK37mMWPLz9PJxkLWllYeRf+EHUSHYEtFop2Eqytaq1FizFVh7XfBnXCDQ==" + }, + "cssesc": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/cssesc/-/cssesc-3.0.0.tgz", + "integrity": "sha512-/Tb/JcjK111nNScGob5MNtsntNM1aCNUDipB/TkwZFhyDrrE47SOx/18wF2bbjgc3ZzCSKW1T5nt5EbFoAz/Vg==" + }, + "cssnano": { + "version": "4.1.11", + "resolved": "https://registry.npmjs.org/cssnano/-/cssnano-4.1.11.tgz", + "integrity": "sha512-6gZm2htn7xIPJOHY824ERgj8cNPgPxyCSnkXc4v7YvNW+TdVfzgngHcEhy/8D11kUWRUMbke+tC+AUcUsnMz2g==", + "requires": { + "cosmiconfig": "^5.0.0", + "cssnano-preset-default": "^4.0.8", + "is-resolvable": "^1.0.0", + "postcss": "^7.0.0" + } + }, + "cssnano-preset-default": { + "version": "4.0.8", + "resolved": "https://registry.npmjs.org/cssnano-preset-default/-/cssnano-preset-default-4.0.8.tgz", + "integrity": "sha512-LdAyHuq+VRyeVREFmuxUZR1TXjQm8QQU/ktoo/x7bz+SdOge1YKc5eMN6pRW7YWBmyq59CqYba1dJ5cUukEjLQ==", + "requires": { + "css-declaration-sorter": "^4.0.1", + "cssnano-util-raw-cache": "^4.0.1", + "postcss": "^7.0.0", + "postcss-calc": "^7.0.1", + "postcss-colormin": "^4.0.3", + "postcss-convert-values": "^4.0.1", + "postcss-discard-comments": "^4.0.2", + "postcss-discard-duplicates": "^4.0.2", + "postcss-discard-empty": "^4.0.1", + "postcss-discard-overridden": "^4.0.1", + "postcss-merge-longhand": "^4.0.11", + "postcss-merge-rules": "^4.0.3", + "postcss-minify-font-values": "^4.0.2", + "postcss-minify-gradients": "^4.0.2", + "postcss-minify-params": "^4.0.2", + "postcss-minify-selectors": "^4.0.2", + "postcss-normalize-charset": "^4.0.1", + "postcss-normalize-display-values": "^4.0.2", + "postcss-normalize-positions": "^4.0.2", + "postcss-normalize-repeat-style": "^4.0.2", + "postcss-normalize-string": "^4.0.2", + "postcss-normalize-timing-functions": "^4.0.2", + "postcss-normalize-unicode": "^4.0.1", + "postcss-normalize-url": "^4.0.1", + "postcss-normalize-whitespace": "^4.0.2", + "postcss-ordered-values": "^4.1.2", + "postcss-reduce-initial": "^4.0.3", + "postcss-reduce-transforms": "^4.0.2", + "postcss-svgo": "^4.0.3", + "postcss-unique-selectors": "^4.0.1" + } + }, + "cssnano-util-get-arguments": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/cssnano-util-get-arguments/-/cssnano-util-get-arguments-4.0.0.tgz", + "integrity": "sha1-7ToIKZ8h11dBsg87gfGU7UnMFQ8=" + }, + "cssnano-util-get-match": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/cssnano-util-get-match/-/cssnano-util-get-match-4.0.0.tgz", + "integrity": "sha1-wOTKB/U4a7F+xeUiULT1lhNlFW0=" + }, + "cssnano-util-raw-cache": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/cssnano-util-raw-cache/-/cssnano-util-raw-cache-4.0.1.tgz", + "integrity": "sha512-qLuYtWK2b2Dy55I8ZX3ky1Z16WYsx544Q0UWViebptpwn/xDBmog2TLg4f+DBMg1rJ6JDWtn96WHbOKDWt1WQA==", + "requires": { + "postcss": "^7.0.0" + } + }, + "cssnano-util-same-parent": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/cssnano-util-same-parent/-/cssnano-util-same-parent-4.0.1.tgz", + "integrity": "sha512-WcKx5OY+KoSIAxBW6UBBRay1U6vkYheCdjyVNDm85zt5K9mHoGOfsOsqIszfAqrQQFIIKgjh2+FDgIj/zsl21Q==" + }, + "csso": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/csso/-/csso-4.2.0.tgz", + "integrity": "sha512-wvlcdIbf6pwKEk7vHj8/Bkc0B4ylXZruLvOgs9doS5eOsOpuodOV2zJChSpkp+pRpYQLQMeF04nr3Z68Sta9jA==", + "requires": { + "css-tree": "^1.1.2" + }, + "dependencies": { + "css-tree": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/css-tree/-/css-tree-1.1.3.tgz", + "integrity": "sha512-tRpdppF7TRazZrjJ6v3stzv93qxRcSsFmW6cX0Zm2NVKpxE1WV1HblnghVv9TreireHkqI/VDEsfolRF1p6y7Q==", + "requires": { + "mdn-data": "2.0.14", + "source-map": "^0.6.1" + } + }, + "mdn-data": { + "version": "2.0.14", + "resolved": "https://registry.npmjs.org/mdn-data/-/mdn-data-2.0.14.tgz", + "integrity": "sha512-dn6wd0uw5GsdswPFfsgMp5NSB0/aDe6fK94YJV/AJDYXL6HVLWBsxeq7js7Ad+mU2K9LAlwpk6kN2D5mwCPVow==" + } + } + }, + "cssom": { + "version": "0.3.8", + "resolved": "https://registry.npmjs.org/cssom/-/cssom-0.3.8.tgz", + "integrity": "sha512-b0tGHbfegbhPJpxpiBPU2sCkigAqtM9O121le6bbOlgyV+NyGyCmVfJ6QW9eRjz8CpNfWEOYBIMIGRYkLwsIYg==" + }, + "cssstyle": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/cssstyle/-/cssstyle-1.4.0.tgz", + "integrity": "sha512-GBrLZYZ4X4x6/QEoBnIrqb8B/f5l4+8me2dkom/j1Gtbxy0kBv6OGzKuAsGM75bkGwGAFkt56Iwg28S3XTZgSA==", + "requires": { + "cssom": "0.3.x" + } + }, + "cyclist": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/cyclist/-/cyclist-1.0.1.tgz", + "integrity": "sha1-WW6WmP0MgOEgOMK4LW6xs1tiJNk=" + }, + "dargs": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/dargs/-/dargs-5.1.0.tgz", + "integrity": "sha1-7H6lDHhWTNNsnV7Bj2Yyn63ieCk=" + }, + "dashdash": { + "version": "1.14.1", + "resolved": "https://registry.npmjs.org/dashdash/-/dashdash-1.14.1.tgz", + "integrity": "sha1-hTz6D3y+L+1d4gMmuN1YEDX24vA=", + "requires": { + "assert-plus": "^1.0.0" + } + }, + "data-urls": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/data-urls/-/data-urls-1.1.0.tgz", + "integrity": "sha512-YTWYI9se1P55u58gL5GkQHW4P6VJBJ5iBT+B5a7i2Tjadhv52paJG0qHX4A0OR6/t52odI64KP2YvFpkDOi3eQ==", + "requires": { + "abab": "^2.0.0", + "whatwg-mimetype": "^2.2.0", + "whatwg-url": "^7.0.0" + } + }, + "deasync": { + "version": "0.1.21", + "resolved": "https://registry.npmjs.org/deasync/-/deasync-0.1.21.tgz", + "integrity": "sha512-kUmM8Y+PZpMpQ+B4AuOW9k2Pfx/mSupJtxOsLzmnHY2WqZUYRFccFn2RhzPAqt3Xb+sorK/badW2D4zNzqZz5w==", + "requires": { + "bindings": "^1.5.0", + "node-addon-api": "^1.7.1" + } + }, + "debug": { + "version": "4.3.1", + "resolved": "https://registry.npmjs.org/debug/-/debug-4.3.1.tgz", + "integrity": "sha512-doEwdvm4PCeK4K3RQN2ZC2BYUBaxwLARCqZmMjtF8a51J2Rb0xpVloFRnCODwqjpwnAoao4pelN8l3RJdv3gRQ==", + "requires": { + "ms": "2.1.2" + } + }, + "decamelize": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/decamelize/-/decamelize-1.2.0.tgz", + "integrity": "sha1-9lNNFRSCabIDUue+4m9QH5oZEpA=" + }, + "decode-uri-component": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/decode-uri-component/-/decode-uri-component-0.2.0.tgz", + "integrity": "sha1-6zkTMzRYd1y4TNGh+uBiEGu4dUU=" + }, + "deep-equal": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/deep-equal/-/deep-equal-1.1.1.tgz", + "integrity": "sha512-yd9c5AdiqVcR+JjcwUQb9DkhJc8ngNr0MahEBGvDiJw8puWab2yZlh+nkasOnZP+EGTAP6rRp2JzJhJZzvNF8g==", + "requires": { + "is-arguments": "^1.0.4", + "is-date-object": "^1.0.1", + "is-regex": "^1.0.4", + "object-is": "^1.0.1", + "object-keys": "^1.1.1", + "regexp.prototype.flags": "^1.2.0" + } + }, + "deep-is": { + "version": "0.1.3", + "resolved": "https://registry.npmjs.org/deep-is/-/deep-is-0.1.3.tgz", + "integrity": "sha1-s2nW+128E+7PUk+RsHD+7cNXzzQ=" + }, + "default-gateway": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/default-gateway/-/default-gateway-4.2.0.tgz", + "integrity": "sha512-h6sMrVB1VMWVrW13mSc6ia/DwYYw5MN6+exNu1OaJeFac5aSAvwM7lZ0NVfTABuSkQelr4h5oebg3KB1XPdjgA==", + "requires": { + "execa": "^1.0.0", + "ip-regex": "^2.1.0" + }, + "dependencies": { + "execa": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/execa/-/execa-1.0.0.tgz", + "integrity": "sha512-adbxcyWV46qiHyvSp50TKt05tB4tK3HcmF7/nxfAdhnox83seTDbwnaqKO4sXRy7roHAIFqJP/Rw/AuEbX61LA==", + "requires": { + "cross-spawn": "^6.0.0", + "get-stream": "^4.0.0", + "is-stream": "^1.1.0", + "npm-run-path": "^2.0.0", + "p-finally": "^1.0.0", + "signal-exit": "^3.0.0", + "strip-eof": "^1.0.0" + } + }, + "get-stream": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-4.1.0.tgz", + "integrity": "sha512-GMat4EJ5161kIy2HevLlr4luNjBgvmj413KaQA7jt4V8B4RDsfpHk7WQ9GVqfYyyx8OS/L66Kox+rJRNklLK7w==", + "requires": { + "pump": "^3.0.0" + } + }, + "is-stream": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-stream/-/is-stream-1.1.0.tgz", + "integrity": "sha1-EtSj3U5o4Lec6428hBc66A2RykQ=" + }, + "npm-run-path": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/npm-run-path/-/npm-run-path-2.0.2.tgz", + "integrity": "sha1-NakjLfo11wZ7TLLd8jV7GHFTbF8=", + "requires": { + "path-key": "^2.0.0" + } + }, + "p-finally": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/p-finally/-/p-finally-1.0.0.tgz", + "integrity": "sha1-P7z7FbiZpEEjs0ttzBi3JDNqLK4=" + } + } + }, + "defaults": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/defaults/-/defaults-1.0.3.tgz", + "integrity": "sha1-xlYFHpgX2f8I7YgUd/P+QBnz730=", + "requires": { + "clone": "^1.0.2" + }, + "dependencies": { + "clone": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/clone/-/clone-1.0.4.tgz", + "integrity": "sha1-2jCcwmPfFZlMaIypAheco8fNfH4=" + } + } + }, + "define-properties": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/define-properties/-/define-properties-1.1.3.tgz", + "integrity": "sha512-3MqfYKj2lLzdMSf8ZIZE/V+Zuy+BgD6f164e8K2w7dgnpKArBDerGYpM46IYYcjnkdPNMjPk9A6VFB8+3SKlXQ==", + "requires": { + "object-keys": "^1.0.12" + } + }, + "define-property": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-2.0.2.tgz", + "integrity": "sha512-jwK2UV4cnPpbcG7+VRARKTZPUWowwXA8bzH5NP6ud0oeAxyYPuGZUAC7hMugpCdz4BeSZl2Dl9k66CHJ/46ZYQ==", + "requires": { + "is-descriptor": "^1.0.2", + "isobject": "^3.0.1" + }, + "dependencies": { + "is-accessor-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-accessor-descriptor/-/is-accessor-descriptor-1.0.0.tgz", + "integrity": "sha512-m5hnHTkcVsPfqx3AKlyttIPb7J+XykHvJP2B9bZDjlhLIoEq4XoK64Vg7boZlVWYK6LUY94dYPEE7Lh0ZkZKcQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-data-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-data-descriptor/-/is-data-descriptor-1.0.0.tgz", + "integrity": "sha512-jbRXy1FmtAoCjQkVmIVYwuuqDFUbaOeDjmed1tOGPrsMhtJA4rD9tkgA0F1qJ3gRFRXcHYVkdeaP50Q5rE/jLQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-descriptor": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-descriptor/-/is-descriptor-1.0.2.tgz", + "integrity": "sha512-2eis5WqQGV7peooDyLmNEPUrps9+SXX5c9pL3xEB+4e9HnGuDa7mB7kHxHw4CbqS9k1T2hOH3miL8n8WtiYVtg==", + "requires": { + "is-accessor-descriptor": "^1.0.0", + "is-data-descriptor": "^1.0.0", + "kind-of": "^6.0.2" + } + } + } + }, + "del": { + "version": "4.1.1", + "resolved": "https://registry.npmjs.org/del/-/del-4.1.1.tgz", + "integrity": "sha512-QwGuEUouP2kVwQenAsOof5Fv8K9t3D8Ca8NxcXKrIpEHjTXK5J2nXLdP+ALI1cgv8wj7KuwBhTwBkOZSJKM5XQ==", + "requires": { + "@types/glob": "^7.1.1", + "globby": "^6.1.0", + "is-path-cwd": "^2.0.0", + "is-path-in-cwd": "^2.0.0", + "p-map": "^2.0.0", + "pify": "^4.0.1", + "rimraf": "^2.6.3" + } + }, + "delayed-stream": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/delayed-stream/-/delayed-stream-1.0.0.tgz", + "integrity": "sha1-3zrhmayt+31ECqrgsp4icrJOxhk=" + }, + "depd": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/depd/-/depd-1.1.2.tgz", + "integrity": "sha1-m81S4UwJd2PnSbJ0xDRu0uVgtak=" + }, + "des.js": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/des.js/-/des.js-1.0.1.tgz", + "integrity": "sha512-Q0I4pfFrv2VPd34/vfLrFOoRmlYj3OV50i7fskps1jZWK1kApMWWT9G6RRUeYedLcBDIhnSDaUvJMb3AhUlaEA==", + "requires": { + "inherits": "^2.0.1", + "minimalistic-assert": "^1.0.0" + } + }, + "destroy": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/destroy/-/destroy-1.0.4.tgz", + "integrity": "sha1-l4hXRCxEdJ5CBmE+N5RiBYJqvYA=" + }, + "detect-node": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/detect-node/-/detect-node-2.1.0.tgz", + "integrity": "sha512-T0NIuQpnTvFDATNuHN5roPwSBG83rFsuO+MXXH9/3N1eFbn4wcPjttvjMLEPWJ0RGUYgQE7cGgS3tNxbqCGM7g==" + }, + "diffie-hellman": { + "version": "5.0.3", + "resolved": "https://registry.npmjs.org/diffie-hellman/-/diffie-hellman-5.0.3.tgz", + "integrity": "sha512-kqag/Nl+f3GwyK25fhUMYj81BUOrZ9IuJsjIcDE5icNM9FJHAVm3VcUDxdLPoQtTuUylWm6ZIknYJwwaPxsUzg==", + "requires": { + "bn.js": "^4.1.0", + "miller-rabin": "^4.0.0", + "randombytes": "^2.0.0" + }, + "dependencies": { + "bn.js": { + "version": "4.12.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.0.tgz", + "integrity": "sha512-c98Bf3tPniI+scsdk237ku1Dc3ujXQTSgyiPUDEOe7tRkhrqridvh8klBv0HCEso1OLOYcHuCv/cS6DNxKH+ZA==" + } + } + }, + "dns-equal": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/dns-equal/-/dns-equal-1.0.0.tgz", + "integrity": "sha1-s55/HabrCnW6nBcySzR1PEfgZU0=" + }, + "dns-packet": { + "version": "1.3.4", + "resolved": "https://registry.npmjs.org/dns-packet/-/dns-packet-1.3.4.tgz", + "integrity": "sha512-BQ6F4vycLXBvdrJZ6S3gZewt6rcrks9KBgM9vrhW+knGRqc8uEdT7fuCwloc7nny5xNoMJ17HGH0R/6fpo8ECA==", + "requires": { + "ip": "^1.1.0", + "safe-buffer": "^5.0.1" + } + }, + "dns-txt": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/dns-txt/-/dns-txt-2.0.2.tgz", + "integrity": "sha1-uR2Ab10nGI5Ks+fRB9iBocxGQrY=", + "requires": { + "buffer-indexof": "^1.0.0" + } + }, + "dom-converter": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/dom-converter/-/dom-converter-0.2.0.tgz", + "integrity": "sha512-gd3ypIPfOMr9h5jIKq8E3sHOTCjeirnl0WK5ZdS1AW0Odt0b1PaWaHdJ4Qk4klv+YB9aJBS7mESXjFoDQPu6DA==", + "requires": { + "utila": "~0.4" + } + }, + "dom-serializer": { + "version": "0.2.2", + "resolved": "https://registry.npmjs.org/dom-serializer/-/dom-serializer-0.2.2.tgz", + "integrity": "sha512-2/xPb3ORsQ42nHYiSunXkDjPLBaEj/xTwUO4B7XCZQTRk7EBtTOPaygh10YAAh2OI1Qrp6NWfpAhzswj0ydt9g==", + "requires": { + "domelementtype": "^2.0.1", + "entities": "^2.0.0" + }, + "dependencies": { + "domelementtype": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-2.2.0.tgz", + "integrity": "sha512-DtBMo82pv1dFtUmHyr48beiuq792Sxohr+8Hm9zoxklYPfa6n0Z3Byjj2IV7bmr2IyqClnqEQhfgHJJ5QF0R5A==" + } + } + }, + "domain-browser": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/domain-browser/-/domain-browser-1.2.0.tgz", + "integrity": "sha512-jnjyiM6eRyZl2H+W8Q/zLMA481hzi0eszAaBUzIVnmYVDBbnLxVNnfu1HgEBvCbL+71FrxMl3E6lpKH7Ge3OXA==" + }, + "domelementtype": { + "version": "1.3.1", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-1.3.1.tgz", + "integrity": "sha512-BSKB+TSpMpFI/HOxCNr1O8aMOTZ8hT3pM3GQ0w/mWRmkhEDSFJkkyzz4XQsBV44BChwGkrDfMyjVD0eA2aFV3w==" + }, + "domexception": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/domexception/-/domexception-1.0.1.tgz", + "integrity": "sha512-raigMkn7CJNNo6Ihro1fzG7wr3fHuYVytzquZKX5n0yizGsTcYgzdIUwj1X9pK0VvjeihV+XiclP+DjwbsSKug==", + "requires": { + "webidl-conversions": "^4.0.2" + } + }, + "domhandler": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/domhandler/-/domhandler-4.2.0.tgz", + "integrity": "sha512-zk7sgt970kzPks2Bf+dwT/PLzghLnsivb9CcxkvR8Mzr66Olr0Ofd8neSbglHJHaHa2MadfoSdNlKYAaafmWfA==", + "requires": { + "domelementtype": "^2.2.0" + }, + "dependencies": { + "domelementtype": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-2.2.0.tgz", + "integrity": "sha512-DtBMo82pv1dFtUmHyr48beiuq792Sxohr+8Hm9zoxklYPfa6n0Z3Byjj2IV7bmr2IyqClnqEQhfgHJJ5QF0R5A==" + } + } + }, + "domutils": { + "version": "1.7.0", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-1.7.0.tgz", + "integrity": "sha512-Lgd2XcJ/NjEw+7tFvfKxOzCYKZsdct5lczQ2ZaQY8Djz7pfAD3Gbp8ySJWtreII/vDlMVmxwa6pHmdxIYgttDg==", + "requires": { + "dom-serializer": "0", + "domelementtype": "1" + } + }, + "dot-case": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/dot-case/-/dot-case-3.0.4.tgz", + "integrity": "sha512-Kv5nKlh6yRrdrGvxeJ2e5y2eRUpkUosIW4A2AS38zwSz27zu7ufDwQPi5Jhs3XAlGNetl3bmnGhQsMtkKJnj3w==", + "requires": { + "no-case": "^3.0.4", + "tslib": "^2.0.3" + } + }, + "dot-prop": { + "version": "5.3.0", + "resolved": "https://registry.npmjs.org/dot-prop/-/dot-prop-5.3.0.tgz", + "integrity": "sha512-QM8q3zDe58hqUqjraQOmzZ1LIH9SWQJTlEKCH4kJ2oQvLZk7RbQXvtDM2XEq3fwkV9CCvvH4LA0AV+ogFsBM2Q==", + "requires": { + "is-obj": "^2.0.0" + } + }, + "dotenv": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/dotenv/-/dotenv-5.0.1.tgz", + "integrity": "sha512-4As8uPrjfwb7VXC+WnLCbXK7y+Ueb2B3zgNCePYfhxS1PYeaO1YTeplffTEcbfLhvFNGLAz90VvJs9yomG7bow==" + }, + "dotenv-expand": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/dotenv-expand/-/dotenv-expand-4.2.0.tgz", + "integrity": "sha1-3vHxyl1gWdJKdm5YeULCEQbOEnU=" + }, + "duplexer2": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/duplexer2/-/duplexer2-0.1.4.tgz", + "integrity": "sha1-ixLauHjA1p4+eJEFFmKjL8a93ME=", + "requires": { + "readable-stream": "^2.0.2" + } + }, + "duplexify": { + "version": "3.7.1", + "resolved": "https://registry.npmjs.org/duplexify/-/duplexify-3.7.1.tgz", + "integrity": "sha512-07z8uv2wMyS51kKhD1KsdXJg5WQ6t93RneqRxUHnskXVtlYYkLqM0gqStQZ3pj073g687jPCHrqNfCzawLYh5g==", + "requires": { + "end-of-stream": "^1.0.0", + "inherits": "^2.0.1", + "readable-stream": "^2.0.0", + "stream-shift": "^1.0.0" + } + }, + "ecc-jsbn": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/ecc-jsbn/-/ecc-jsbn-0.1.2.tgz", + "integrity": "sha1-OoOpBOVDUyh4dMVkt1SThoSamMk=", + "requires": { + "jsbn": "~0.1.0", + "safer-buffer": "^2.1.0" + } + }, + "editorconfig": { + "version": "0.15.3", + "resolved": "https://registry.npmjs.org/editorconfig/-/editorconfig-0.15.3.tgz", + "integrity": "sha512-M9wIMFx96vq0R4F+gRpY3o2exzb8hEj/n9S8unZtHSvYjibBp/iMufSzvmOcV/laG0ZtuTVGtiJggPOSW2r93g==", + "requires": { + "commander": "^2.19.0", + "lru-cache": "^4.1.5", + "semver": "^5.6.0", + "sigmund": "^1.0.1" + } + }, + "ee-first": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/ee-first/-/ee-first-1.1.1.tgz", + "integrity": "sha1-WQxhFWsK4vTwJVcyoViyZrxWsh0=" + }, + "electron-to-chromium": { + "version": "1.3.759", + "resolved": "https://registry.npmjs.org/electron-to-chromium/-/electron-to-chromium-1.3.759.tgz", + "integrity": "sha512-nM76xH0t2FBH5iMEZDVc3S/qbdKjGH7TThezxC8k1Q7w7WHvIAyJh8lAe2UamGfdRqBTjHfPDn82LJ0ksCiB9g==" + }, + "elliptic": { + "version": "6.5.4", + "resolved": "https://registry.npmjs.org/elliptic/-/elliptic-6.5.4.tgz", + "integrity": "sha512-iLhC6ULemrljPZb+QutR5TQGB+pdW6KGD5RSegS+8sorOZT+rdQFbsQFJgvN3eRqNALqJer4oQ16YvJHlU8hzQ==", + "requires": { + "bn.js": "^4.11.9", + "brorand": "^1.1.0", + "hash.js": "^1.0.0", + "hmac-drbg": "^1.0.1", + "inherits": "^2.0.4", + "minimalistic-assert": "^1.0.1", + "minimalistic-crypto-utils": "^1.0.1" + }, + "dependencies": { + "bn.js": { + "version": "4.12.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.0.tgz", + "integrity": "sha512-c98Bf3tPniI+scsdk237ku1Dc3ujXQTSgyiPUDEOe7tRkhrqridvh8klBv0HCEso1OLOYcHuCv/cS6DNxKH+ZA==" + } + } + }, + "emoji-regex": { + "version": "7.0.3", + "resolved": "https://registry.npmjs.org/emoji-regex/-/emoji-regex-7.0.3.tgz", + "integrity": "sha512-CwBLREIQ7LvYFB0WyRvwhq5N5qPhc6PMjD6bYggFlI5YyDgl+0vxq5VHbMOFqLg7hfWzmu8T5Z1QofhmTIhItA==" + }, + "emojis-list": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/emojis-list/-/emojis-list-3.0.0.tgz", + "integrity": "sha512-/kyM18EfinwXZbno9FyUGeFh87KC8HRQBQGildHZbEuRyWFOmv1U10o9BBp8XVZDVNNuQKyIGIu5ZYAAXJ0V2Q==" + }, + "encodeurl": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/encodeurl/-/encodeurl-1.0.2.tgz", + "integrity": "sha1-rT/0yG7C0CkyL1oCw6mmBslbP1k=" + }, + "end-of-stream": { + "version": "1.4.4", + "resolved": "https://registry.npmjs.org/end-of-stream/-/end-of-stream-1.4.4.tgz", + "integrity": "sha512-+uw1inIHVPQoaVuHzRyXd21icM+cnt4CzD5rW+NC1wjOUSTOs+Te7FOv7AhN7vS9x/oIyhLP5PR1H+phQAHu5Q==", + "requires": { + "once": "^1.4.0" + } + }, + "enhanced-resolve": { + "version": "5.8.2", + "resolved": "https://registry.npmjs.org/enhanced-resolve/-/enhanced-resolve-5.8.2.tgz", + "integrity": "sha512-F27oB3WuHDzvR2DOGNTaYy0D5o0cnrv8TeI482VM4kYgQd/FT9lUQwuNsJ0oOHtBUq7eiW5ytqzp7nBFknL+GA==", + "requires": { + "graceful-fs": "^4.2.4", + "tapable": "^2.2.0" + } + }, + "entities": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/entities/-/entities-2.2.0.tgz", + "integrity": "sha512-p92if5Nz619I0w+akJrLZH0MX0Pb5DX39XOwQTtXSdQQOaYH03S1uIQp4mhOZtAXrxq4ViO67YTiLBo2638o9A==" + }, + "env-paths": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/env-paths/-/env-paths-2.2.1.tgz", + "integrity": "sha512-+h1lkLKhZMTYjog1VEpJNG7NZJWcuc2DDk/qsqSTRRCOXiLjeQ1d1/udrUGhqMxUgAlwKNZ0cf2uqan5GLuS2A==" + }, + "envinfo": { + "version": "7.8.1", + "resolved": "https://registry.npmjs.org/envinfo/-/envinfo-7.8.1.tgz", + "integrity": "sha512-/o+BXHmB7ocbHEAs6F2EnG0ogybVVUdkRunTT2glZU9XAaGmhqskrvKwqXuDfNjEO0LZKWdejEEpnq8aM0tOaw==" + }, + "err-code": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/err-code/-/err-code-1.1.2.tgz", + "integrity": "sha1-BuARbTAo9q70gGhJ6w6mp0iuaWA=" + }, + "errno": { + "version": "0.1.8", + "resolved": "https://registry.npmjs.org/errno/-/errno-0.1.8.tgz", + "integrity": "sha512-dJ6oBr5SQ1VSd9qkk7ByRgb/1SH4JZjCHSW/mr63/QcXO9zLVxvJ6Oy13nio03rxpSnVDDjFor75SjVeZWPW/A==", + "requires": { + "prr": "~1.0.1" + } + }, + "error-ex": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/error-ex/-/error-ex-1.3.2.tgz", + "integrity": "sha512-7dFHNmqeFSEt2ZBsCriorKnn3Z2pj+fd9kmI6QoWw4//DL+icEBfc0U7qJCisqrTsKTjw4fNFy2pW9OqStD84g==", + "requires": { + "is-arrayish": "^0.2.1" + } + }, + "es-abstract": { + "version": "1.18.3", + "resolved": "https://registry.npmjs.org/es-abstract/-/es-abstract-1.18.3.tgz", + "integrity": "sha512-nQIr12dxV7SSxE6r6f1l3DtAeEYdsGpps13dR0TwJg1S8gyp4ZPgy3FZcHBgbiQqnoqSTb+oC+kO4UQ0C/J8vw==", + "requires": { + "call-bind": "^1.0.2", + "es-to-primitive": "^1.2.1", + "function-bind": "^1.1.1", + "get-intrinsic": "^1.1.1", + "has": "^1.0.3", + "has-symbols": "^1.0.2", + "is-callable": "^1.2.3", + "is-negative-zero": "^2.0.1", + "is-regex": "^1.1.3", + "is-string": "^1.0.6", + "object-inspect": "^1.10.3", + "object-keys": "^1.1.1", + "object.assign": "^4.1.2", + "string.prototype.trimend": "^1.0.4", + "string.prototype.trimstart": "^1.0.4", + "unbox-primitive": "^1.0.1" + }, + "dependencies": { + "object-inspect": { + "version": "1.10.3", + "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.10.3.tgz", + "integrity": "sha512-e5mCJlSH7poANfC8z8S9s9S2IN5/4Zb3aZ33f5s8YqoazCFzNLloLU8r5VCG+G7WoqLvAAZoVMcy3tp/3X0Plw==" + } + } + }, + "es-module-lexer": { + "version": "0.6.0", + "resolved": "https://registry.npmjs.org/es-module-lexer/-/es-module-lexer-0.6.0.tgz", + "integrity": "sha512-f8kcHX1ArhllUtb/wVSyvygoKCznIjnxhLxy7TCvIiMdT7fL4ZDTIKaadMe6eLvOXg6Wk02UeoFgUoZ2EKZZUA==" + }, + "es-to-primitive": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/es-to-primitive/-/es-to-primitive-1.2.1.tgz", + "integrity": "sha512-QCOllgZJtaUo9miYBcLChTUaHNjJF3PYs1VidD7AwiEj1kYxKeQTctLAezAOH5ZKRH0g2IgPn6KwB4IT8iRpvA==", + "requires": { + "is-callable": "^1.1.4", + "is-date-object": "^1.0.1", + "is-symbol": "^1.0.2" + } + }, + "escalade": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/escalade/-/escalade-3.1.1.tgz", + "integrity": "sha512-k0er2gUkLf8O0zKJiAhmkTnJlTvINGv7ygDNPbeIsX/TJjGJZHuh9B2UxbsaEkmlEo9MfhrSzmhIlhRlI2GXnw==" + }, + "escape-html": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/escape-html/-/escape-html-1.0.3.tgz", + "integrity": "sha1-Aljq5NPQwJdN4cFpGI7wBR0dGYg=" + }, + "escape-string-regexp": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/escape-string-regexp/-/escape-string-regexp-1.0.5.tgz", + "integrity": "sha1-G2HAViGQqN/2rjuyzwIAyhMLhtQ=" + }, + "escodegen": { + "version": "1.9.1", + "resolved": "https://registry.npmjs.org/escodegen/-/escodegen-1.9.1.tgz", + "integrity": "sha512-6hTjO1NAWkHnDk3OqQ4YrCuwwmGHL9S3nPlzBOUG/R44rda3wLNrfvQ5fkSGjyhHFKM7ALPKcKGrwvCLe0lC7Q==", + "requires": { + "esprima": "^3.1.3", + "estraverse": "^4.2.0", + "esutils": "^2.0.2", + "optionator": "^0.8.1", + "source-map": "~0.6.1" + } + }, + "eslint-scope": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/eslint-scope/-/eslint-scope-5.1.1.tgz", + "integrity": "sha512-2NxwbF/hZ0KpepYN0cNbo+FN6XoK7GaHlQhgx/hIZl6Va0bF45RQOOwhLIy8lQDbuCiadSLCBnH2CFYquit5bw==", + "requires": { + "esrecurse": "^4.3.0", + "estraverse": "^4.1.1" + } + }, + "esprima": { + "version": "3.1.3", + "resolved": "https://registry.npmjs.org/esprima/-/esprima-3.1.3.tgz", + "integrity": "sha1-/cpRzuYTOJXjyI1TXOSdv/YqRjM=" + }, + "esrecurse": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/esrecurse/-/esrecurse-4.3.0.tgz", + "integrity": "sha512-KmfKL3b6G+RXvP8N1vr3Tq1kL/oCFgn2NYXEtqP8/L3pKapUA4G8cFVaoF3SU323CD4XypR/ffioHmkti6/Tag==", + "requires": { + "estraverse": "^5.2.0" + }, + "dependencies": { + "estraverse": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/estraverse/-/estraverse-5.2.0.tgz", + "integrity": "sha512-BxbNGGNm0RyRYvUdHpIwv9IWzeM9XClbOxwoATuFdOE7ZE6wHL+HQ5T8hoPM+zHvmKzzsEqhgy0GrQ5X13afiQ==" + } + } + }, + "estraverse": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/estraverse/-/estraverse-4.3.0.tgz", + "integrity": "sha512-39nnKffWz8xN1BU/2c79n9nB9HDzo0niYUqx6xyqUnyoAnQyyWpOTdZEeiCch8BBu515t4wp9ZmgVfVhn9EBpw==" + }, + "esutils": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/esutils/-/esutils-2.0.3.tgz", + "integrity": "sha512-kVscqXk4OCp68SZ0dkgEKVi6/8ij300KBWTJq32P/dYeWTSwK41WyTxalN1eRmA5Z9UU/LX9D7FWSmV9SAYx6g==" + }, + "etag": { + "version": "1.8.1", + "resolved": "https://registry.npmjs.org/etag/-/etag-1.8.1.tgz", + "integrity": "sha1-Qa4u62XvpiJorr/qg6x9eSmbCIc=" + }, + "eventemitter3": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/eventemitter3/-/eventemitter3-1.2.0.tgz", + "integrity": "sha1-HIaZHYFq0eUEdQ5zh0Ik7PO+xQg=" + }, + "events": { + "version": "3.3.0", + "resolved": "https://registry.npmjs.org/events/-/events-3.3.0.tgz", + "integrity": "sha512-mQw+2fkQbALzQ7V0MY0IqdnXNOeTtP4r0lN9z7AAawCXgqea7bDii20AYrIBrFd/Hx0M2Ocz6S111CaFkUcb0Q==" + }, + "eventsource": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/eventsource/-/eventsource-1.1.0.tgz", + "integrity": "sha512-VSJjT5oCNrFvCS6igjzPAt5hBzQ2qPBFIbJ03zLI9SE0mxwZpMw6BfJrbFHm1a141AavMEB8JHmBhWAd66PfCg==", + "requires": { + "original": "^1.0.0" + } + }, + "evp_bytestokey": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/evp_bytestokey/-/evp_bytestokey-1.0.3.tgz", + "integrity": "sha512-/f2Go4TognH/KvCISP7OUsHn85hT9nUkxxA9BEWxFn+Oj9o8ZNLm/40hdlgSLyuOimsrTKLUMEorQexp/aPQeA==", + "requires": { + "md5.js": "^1.3.4", + "safe-buffer": "^5.1.1" + } + }, + "execa": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/execa/-/execa-2.1.0.tgz", + "integrity": "sha512-Y/URAVapfbYy2Xp/gb6A0E7iR8xeqOCXsuuaoMn7A5PzrXUK84E1gyiEfq0wQd/GHA6GsoHWwhNq8anb0mleIw==", + "requires": { + "cross-spawn": "^7.0.0", + "get-stream": "^5.0.0", + "is-stream": "^2.0.0", + "merge-stream": "^2.0.0", + "npm-run-path": "^3.0.0", + "onetime": "^5.1.0", + "p-finally": "^2.0.0", + "signal-exit": "^3.0.2", + "strip-final-newline": "^2.0.0" + }, + "dependencies": { + "cross-spawn": { + "version": "7.0.3", + "resolved": "https://registry.npmjs.org/cross-spawn/-/cross-spawn-7.0.3.tgz", + "integrity": "sha512-iRDPJKUPVEND7dHPO8rkbOnPpyDygcDFtWjpeWNCgy8WP2rXcxXL8TskReQl6OrB2G7+UJrags1q15Fudc7G6w==", + "requires": { + "path-key": "^3.1.0", + "shebang-command": "^2.0.0", + "which": "^2.0.1" + } + }, + "mimic-fn": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz", + "integrity": "sha512-OqbOk5oEQeAZ8WXWydlu9HJjz9WVdEIvamMCcXmuqUYjTknH/sqsWvhQ3vgwKFRR1HpjvNBKQ37nbJgYzGqGcg==" + }, + "onetime": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/onetime/-/onetime-5.1.2.tgz", + "integrity": "sha512-kbpaSSGJTWdAY5KPVeMOKXSrPtr8C8C7wodJbcsd51jRnmD+GZu8Y0VoU6Dm5Z4vWr0Ig/1NKuWRKf7j5aaYSg==", + "requires": { + "mimic-fn": "^2.1.0" + } + }, + "path-key": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/path-key/-/path-key-3.1.1.tgz", + "integrity": "sha512-ojmeN0qd+y0jszEtoY48r0Peq5dwMEkIlCOu6Q5f41lfkswXuKtYrhgoTpLnyIcHm24Uhqx+5Tqm2InSwLhE6Q==" + }, + "shebang-command": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/shebang-command/-/shebang-command-2.0.0.tgz", + "integrity": "sha512-kHxr2zZpYtdmrN1qDjrrX/Z1rR1kG8Dx+gkpK1G4eXmvXswmcE1hTWBWYUzlraYw1/yZp6YuDY77YtvbN0dmDA==", + "requires": { + "shebang-regex": "^3.0.0" + } + }, + "shebang-regex": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/shebang-regex/-/shebang-regex-3.0.0.tgz", + "integrity": "sha512-7++dFhtcx3353uBaq8DDR4NuxBetBzC7ZQOhmTQInHEd6bSrXdiEyzCvG07Z44UYdLShWUyXt5M/yhz8ekcb1A==" + }, + "which": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/which/-/which-2.0.2.tgz", + "integrity": "sha512-BLI3Tl1TW3Pvl70l3yq3Y64i+awpwXqsGBYWkkqMtnbXgrMD+yj7rhW0kuEDxzJaYXGjEW5ogapKNMEKNMjibA==", + "requires": { + "isexe": "^2.0.0" + } + } + } + }, + "expand-brackets": { + "version": "2.1.4", + "resolved": "https://registry.npmjs.org/expand-brackets/-/expand-brackets-2.1.4.tgz", + "integrity": "sha1-t3c14xXOMPa27/D4OwQVGiJEliI=", + "requires": { + "debug": "^2.3.3", + "define-property": "^0.2.5", + "extend-shallow": "^2.0.1", + "posix-character-classes": "^0.1.0", + "regex-not": "^1.0.0", + "snapdragon": "^0.8.1", + "to-regex": "^3.0.1" + }, + "dependencies": { + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "define-property": { + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-0.2.5.tgz", + "integrity": "sha1-w1se+RjsPJkPmlvFe+BKrOxcgRY=", + "requires": { + "is-descriptor": "^0.1.0" + } + }, + "extend-shallow": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz", + "integrity": "sha1-Ua99YUrZqfYQ6huvu5idaxxWiQ8=", + "requires": { + "is-extendable": "^0.1.0" + } + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + } + } + }, + "express": { + "version": "4.17.1", + "resolved": "https://registry.npmjs.org/express/-/express-4.17.1.tgz", + "integrity": "sha512-mHJ9O79RqluphRrcw2X/GTh3k9tVv8YcoyY4Kkh4WDMUYKRZUq0h1o0w2rrrxBqM7VoeUVqgb27xlEMXTnYt4g==", + "requires": { + "accepts": "~1.3.7", + "array-flatten": "1.1.1", + "body-parser": "1.19.0", + "content-disposition": "0.5.3", + "content-type": "~1.0.4", + "cookie": "0.4.0", + "cookie-signature": "1.0.6", + "debug": "2.6.9", + "depd": "~1.1.2", + "encodeurl": "~1.0.2", + "escape-html": "~1.0.3", + "etag": "~1.8.1", + "finalhandler": "~1.1.2", + "fresh": "0.5.2", + "merge-descriptors": "1.0.1", + "methods": "~1.1.2", + "on-finished": "~2.3.0", + "parseurl": "~1.3.3", + "path-to-regexp": "0.1.7", + "proxy-addr": "~2.0.5", + "qs": "6.7.0", + "range-parser": "~1.2.1", + "safe-buffer": "5.1.2", + "send": "0.17.1", + "serve-static": "1.14.1", + "setprototypeof": "1.1.1", + "statuses": "~1.5.0", + "type-is": "~1.6.18", + "utils-merge": "1.0.1", + "vary": "~1.1.2" + }, + "dependencies": { + "array-flatten": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/array-flatten/-/array-flatten-1.1.1.tgz", + "integrity": "sha1-ml9pkFGx5wczKPKgCJaLZOopVdI=" + }, + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + }, + "qs": { + "version": "6.7.0", + "resolved": "https://registry.npmjs.org/qs/-/qs-6.7.0.tgz", + "integrity": "sha512-VCdBRNFTX1fyE7Nb6FYoURo/SPe62QCaAyzJvUjwRaIsc+NePBEniHlvxFmmX56+HZphIGtV0XeCirBtpDrTyQ==" + } + } + }, + "extend": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/extend/-/extend-3.0.2.tgz", + "integrity": "sha512-fjquC59cD7CyW6urNXK0FBufkZcoiGG80wTuPujX590cB5Ttln20E2UB4S/WARVqhXffZl2LNgS+gQdPIIim/g==" + }, + "extend-shallow": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-3.0.2.tgz", + "integrity": "sha1-Jqcarwc7OfshJxcnRhMcJwQCjbg=", + "requires": { + "assign-symbols": "^1.0.0", + "is-extendable": "^1.0.1" + }, + "dependencies": { + "is-extendable": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/is-extendable/-/is-extendable-1.0.1.tgz", + "integrity": "sha512-arnXMxT1hhoKo9k1LZdmlNyJdDDfy2v0fXjFlmok4+i8ul/6WlbVge9bhM74OpNPQPMGUToDtz+KXa1PneJxOA==", + "requires": { + "is-plain-object": "^2.0.4" + } + } + } + }, + "extglob": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/extglob/-/extglob-2.0.4.tgz", + "integrity": "sha512-Nmb6QXkELsuBr24CJSkilo6UHHgbekK5UiZgfE6UHD3Eb27YC6oD+bhcT+tJ6cl8dmsgdQxnWlcry8ksBIBLpw==", + "requires": { + "array-unique": "^0.3.2", + "define-property": "^1.0.0", + "expand-brackets": "^2.1.4", + "extend-shallow": "^2.0.1", + "fragment-cache": "^0.2.1", + "regex-not": "^1.0.0", + "snapdragon": "^0.8.1", + "to-regex": "^3.0.1" + }, + "dependencies": { + "define-property": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-1.0.0.tgz", + "integrity": "sha1-dp66rz9KY6rTr56NMEybvnm/sOY=", + "requires": { + "is-descriptor": "^1.0.0" + } + }, + "extend-shallow": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz", + "integrity": "sha1-Ua99YUrZqfYQ6huvu5idaxxWiQ8=", + "requires": { + "is-extendable": "^0.1.0" + } + }, + "is-accessor-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-accessor-descriptor/-/is-accessor-descriptor-1.0.0.tgz", + "integrity": "sha512-m5hnHTkcVsPfqx3AKlyttIPb7J+XykHvJP2B9bZDjlhLIoEq4XoK64Vg7boZlVWYK6LUY94dYPEE7Lh0ZkZKcQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-data-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-data-descriptor/-/is-data-descriptor-1.0.0.tgz", + "integrity": "sha512-jbRXy1FmtAoCjQkVmIVYwuuqDFUbaOeDjmed1tOGPrsMhtJA4rD9tkgA0F1qJ3gRFRXcHYVkdeaP50Q5rE/jLQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-descriptor": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-descriptor/-/is-descriptor-1.0.2.tgz", + "integrity": "sha512-2eis5WqQGV7peooDyLmNEPUrps9+SXX5c9pL3xEB+4e9HnGuDa7mB7kHxHw4CbqS9k1T2hOH3miL8n8WtiYVtg==", + "requires": { + "is-accessor-descriptor": "^1.0.0", + "is-data-descriptor": "^1.0.0", + "kind-of": "^6.0.2" + } + } + } + }, + "extsprintf": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/extsprintf/-/extsprintf-1.3.0.tgz", + "integrity": "sha1-lpGEQOMEGnpBT4xS48V06zw+HgU=" + }, + "falafel": { + "version": "2.2.4", + "resolved": "https://registry.npmjs.org/falafel/-/falafel-2.2.4.tgz", + "integrity": "sha512-0HXjo8XASWRmsS0X1EkhwEMZaD3Qvp7FfURwjLKjG1ghfRm/MGZl2r4cWUTv41KdNghTw4OUMmVtdGQp3+H+uQ==", + "requires": { + "acorn": "^7.1.1", + "foreach": "^2.0.5", + "isarray": "^2.0.1", + "object-keys": "^1.0.6" + }, + "dependencies": { + "isarray": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-2.0.5.tgz", + "integrity": "sha512-xHjhDr3cNBK0BzdUJSPXZntQUx/mwMS5Rw4A7lPJ90XGAO6ISP/ePDNuo0vhqOZU+UD5JoodwCAAoZQd3FeAKw==" + } + } + }, + "fast-deep-equal": { + "version": "3.1.3", + "resolved": "https://registry.npmjs.org/fast-deep-equal/-/fast-deep-equal-3.1.3.tgz", + "integrity": "sha512-f3qQ9oQy9j2AhBe/H9VC91wLmKBCCU/gDOnKNAYG5hswO7BLKj09Hc5HYNz9cGI++xlpDCIgDaitVs03ATR84Q==" + }, + "fast-glob": { + "version": "2.2.7", + "resolved": "https://registry.npmjs.org/fast-glob/-/fast-glob-2.2.7.tgz", + "integrity": "sha512-g1KuQwHOZAmOZMuBtHdxDtju+T2RT8jgCC9aANsbpdiDDTSnjgfuVsIBNKbUeJI3oKMRExcfNDtJl4OhbffMsw==", + "requires": { + "@mrmlnc/readdir-enhanced": "^2.2.1", + "@nodelib/fs.stat": "^1.1.2", + "glob-parent": "^3.1.0", + "is-glob": "^4.0.0", + "merge2": "^1.2.3", + "micromatch": "^3.1.10" + } + }, + "fast-json-stable-stringify": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/fast-json-stable-stringify/-/fast-json-stable-stringify-2.1.0.tgz", + "integrity": "sha512-lhd/wF+Lk98HZoTCtlVraHtfh5XYijIjalXck7saUtuanSDyLMxnHhSXEDJqHxD7msR8D0uCmqlkwjCV8xvwHw==" + }, + "fast-levenshtein": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/fast-levenshtein/-/fast-levenshtein-2.0.6.tgz", + "integrity": "sha1-PYpcZog6FqMMqGQ+hR8Zuqd5eRc=" + }, + "fastest-levenshtein": { + "version": "1.0.12", + "resolved": "https://registry.npmjs.org/fastest-levenshtein/-/fastest-levenshtein-1.0.12.tgz", + "integrity": "sha512-On2N+BpYJ15xIC974QNVuYGMOlEVt4s0EOI3wwMqOmK1fdDY+FN/zltPV8vosq4ad4c/gJ1KHScUn/6AWIgiow==" + }, + "fastparse": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/fastparse/-/fastparse-1.1.2.tgz", + "integrity": "sha512-483XLLxTVIwWK3QTrMGRqUfUpoOs/0hbQrl2oz4J0pAcm3A3bu84wxTFqGqkJzewCLdME38xJLJAxBABfQT8sQ==" + }, + "faye-websocket": { + "version": "0.11.4", + "resolved": "https://registry.npmjs.org/faye-websocket/-/faye-websocket-0.11.4.tgz", + "integrity": "sha512-CzbClwlXAuiRQAlUyfqPgvPoNKTckTPGfwZV4ZdAhVcP2lh9KUxJg2b5GkE7XbjKQ3YJnQ9z6D9ntLAlB+tP8g==", + "requires": { + "websocket-driver": ">=0.5.1" + } + }, + "figgy-pudding": { + "version": "3.5.2", + "resolved": "https://registry.npmjs.org/figgy-pudding/-/figgy-pudding-3.5.2.tgz", + "integrity": "sha512-0btnI/H8f2pavGMN8w40mlSKOfTK2SVJmBfBeVIj3kNw0swwgzyRq0d5TJVOwodFmtvpPeWPN/MCcfuWF0Ezbw==" + }, + "file-uri-to-path": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/file-uri-to-path/-/file-uri-to-path-1.0.0.tgz", + "integrity": "sha512-0Zt+s3L7Vf1biwWZ29aARiVYLx7iMGnEUl9x33fbB/j3jR81u/O2LbqK+Bm1CDSNDKVtJ/YjwY7TUd5SkeLQLw==" + }, + "filesize": { + "version": "3.6.1", + "resolved": "https://registry.npmjs.org/filesize/-/filesize-3.6.1.tgz", + "integrity": "sha512-7KjR1vv6qnicaPMi1iiTcI85CyYwRO/PSFCu6SvqL8jN2Wjt/NIYQTFtFs7fSDCYOstUkEWIQGFUg5YZQfjlcg==" + }, + "fill-range": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/fill-range/-/fill-range-4.0.0.tgz", + "integrity": "sha1-1USBHUKPmOsGpj3EAtJAPDKMOPc=", + "requires": { + "extend-shallow": "^2.0.1", + "is-number": "^3.0.0", + "repeat-string": "^1.6.1", + "to-regex-range": "^2.1.0" + }, + "dependencies": { + "extend-shallow": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz", + "integrity": "sha1-Ua99YUrZqfYQ6huvu5idaxxWiQ8=", + "requires": { + "is-extendable": "^0.1.0" + } + } + } + }, + "finalhandler": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/finalhandler/-/finalhandler-1.1.2.tgz", + "integrity": "sha512-aAWcW57uxVNrQZqFXjITpW3sIUQmHGG3qSb9mUah9MgMC4NeWhNOlNjXEYq3HjRAvL6arUviZGGJsBg6z0zsWA==", + "requires": { + "debug": "2.6.9", + "encodeurl": "~1.0.2", + "escape-html": "~1.0.3", + "on-finished": "~2.3.0", + "parseurl": "~1.3.3", + "statuses": "~1.5.0", + "unpipe": "~1.0.0" + }, + "dependencies": { + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + } + } + }, + "find-up": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-4.1.0.tgz", + "integrity": "sha512-PpOwAdQ/YlXQ2vj8a3h8IipDuYRi3wceVQQGYWxNINccq40Anw7BlsEXCMbt1Zt+OLA6Fq9suIpIWD0OsnISlw==", + "requires": { + "locate-path": "^5.0.0", + "path-exists": "^4.0.0" + } + }, + "flush-write-stream": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/flush-write-stream/-/flush-write-stream-1.1.1.tgz", + "integrity": "sha512-3Z4XhFZ3992uIq0XOqb9AreonueSYphE6oYbpt5+3u06JWklbsPkNv3ZKkP9Bz/r+1MWCaMoSQ28P85+1Yc77w==", + "requires": { + "inherits": "^2.0.3", + "readable-stream": "^2.3.6" + } + }, + "follow-redirects": { + "version": "1.14.1", + "resolved": "https://registry.npmjs.org/follow-redirects/-/follow-redirects-1.14.1.tgz", + "integrity": "sha512-HWqDgT7ZEkqRzBvc2s64vSZ/hfOceEol3ac/7tKwzuvEyWx3/4UegXh5oBOIotkGsObyk3xznnSRVADBgWSQVg==" + }, + "for-in": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/for-in/-/for-in-1.0.2.tgz", + "integrity": "sha1-gQaNKVqBQuwKxybG4iAMMPttXoA=" + }, + "foreach": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/foreach/-/foreach-2.0.5.tgz", + "integrity": "sha1-C+4AUBiusmDQo6865ljdATbsG5k=" + }, + "forever-agent": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/forever-agent/-/forever-agent-0.6.1.tgz", + "integrity": "sha1-+8cfDEGt6zf5bFd60e1C2P2sypE=" + }, + "form-data": { + "version": "2.3.3", + "resolved": "https://registry.npmjs.org/form-data/-/form-data-2.3.3.tgz", + "integrity": "sha512-1lLKB2Mu3aGP1Q/2eCOx0fNbRMe7XdwktwOruhfqqd0rIJWwN4Dh+E3hrPSlDCXnSR7UtZ1N38rVXm+6+MEhJQ==", + "requires": { + "asynckit": "^0.4.0", + "combined-stream": "^1.0.6", + "mime-types": "^2.1.12" + } + }, + "forwarded": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/forwarded/-/forwarded-0.2.0.tgz", + "integrity": "sha512-buRG0fpBtRHSTCOASe6hD258tEubFoRLb4ZNA6NxMVHNw2gOcwHo9wyablzMzOA5z9xA9L1KNjk/Nt6MT9aYow==" + }, + "fragment-cache": { + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/fragment-cache/-/fragment-cache-0.2.1.tgz", + "integrity": "sha1-QpD60n8T6Jvn8zeZxrxaCr//DRk=", + "requires": { + "map-cache": "^0.2.2" + } + }, + "fresh": { + "version": "0.5.2", + "resolved": "https://registry.npmjs.org/fresh/-/fresh-0.5.2.tgz", + "integrity": "sha1-PYyt2Q2XZWn6g1qx+OSyOhBWBac=" + }, + "from2": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/from2/-/from2-2.3.0.tgz", + "integrity": "sha1-i/tVAr3kpNNs/e6gB/zKIdfjgq8=", + "requires": { + "inherits": "^2.0.1", + "readable-stream": "^2.0.0" + } + }, + "fs-minipass": { + "version": "1.2.7", + "resolved": "https://registry.npmjs.org/fs-minipass/-/fs-minipass-1.2.7.tgz", + "integrity": "sha512-GWSSJGFy4e9GUeCcbIkED+bgAoFyj7XF1mV8rma3QW4NIqX9Kyx79N/PF61H5udOV3aY1IaMLs6pGbH71nlCTA==", + "requires": { + "minipass": "^2.6.0" + } + }, + "fs-write-stream-atomic": { + "version": "1.0.10", + "resolved": "https://registry.npmjs.org/fs-write-stream-atomic/-/fs-write-stream-atomic-1.0.10.tgz", + "integrity": "sha1-tH31NJPvkR33VzHnCp3tAYnbQMk=", + "requires": { + "graceful-fs": "^4.1.2", + "iferr": "^0.1.5", + "imurmurhash": "^0.1.4", + "readable-stream": "1 || 2" + } + }, + "fs.realpath": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/fs.realpath/-/fs.realpath-1.0.0.tgz", + "integrity": "sha1-FQStJSMVjKpA20onh8sBQRmU6k8=" + }, + "fsevents": { + "version": "1.2.13", + "resolved": "https://registry.npmjs.org/fsevents/-/fsevents-1.2.13.tgz", + "integrity": "sha512-oWb1Z6mkHIskLzEJ/XWX0srkpkTQ7vaopMQkyaEIoq0fmtFVxOthb8cCxeT+p3ynTdkk/RZwbgG4brR5BeWECw==", + "optional": true, + "requires": { + "bindings": "^1.5.0", + "nan": "^2.12.1" + } + }, + "function-bind": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/function-bind/-/function-bind-1.1.1.tgz", + "integrity": "sha512-yIovAzMX49sF8Yl58fSCWJ5svSLuaibPxXQJFLmBObTuCr0Mf1KiPopGM9NiFjiYBCbfaa2Fh6breQ6ANVTI0A==" + }, + "get-caller-file": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/get-caller-file/-/get-caller-file-2.0.5.tgz", + "integrity": "sha512-DyFP3BM/3YHTQOCUL/w0OZHR0lpKeGrxotcHWcqNEdnltqFwXVfhEBQ94eIo34AfQpo0rGki4cyIiftY06h2Fg==" + }, + "get-intrinsic": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/get-intrinsic/-/get-intrinsic-1.1.1.tgz", + "integrity": "sha512-kWZrnVM42QCiEA2Ig1bG8zjoIMOgxWwYCEeNdwY6Tv/cOSeGpcoX4pXHfKUxNKVoArnrEr2e9srnAxxGIraS9Q==", + "requires": { + "function-bind": "^1.1.1", + "has": "^1.0.3", + "has-symbols": "^1.0.1" + } + }, + "get-port": { + "version": "3.2.0", + "resolved": "https://registry.npmjs.org/get-port/-/get-port-3.2.0.tgz", + "integrity": "sha1-3Xzn3hh8Bsi/NTeWrHHgmfCYDrw=" + }, + "get-stream": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-5.2.0.tgz", + "integrity": "sha512-nBF+F1rAZVCu/p7rjzgA+Yb4lfYXrpl7a6VmJrU8wF9I1CKvP/QwPNZHnOlwbTkY6dvtFIzFMSyQXbLoTQPRpA==", + "requires": { + "pump": "^3.0.0" + } + }, + "get-value": { + "version": "2.0.6", + "resolved": "https://registry.npmjs.org/get-value/-/get-value-2.0.6.tgz", + "integrity": "sha1-3BXKHGcjh8p2vTesCjlbogQqLCg=" + }, + "getpass": { + "version": "0.1.7", + "resolved": "https://registry.npmjs.org/getpass/-/getpass-0.1.7.tgz", + "integrity": "sha1-Xv+OPmhNVprkyysSgmBOi6YhSfo=", + "requires": { + "assert-plus": "^1.0.0" + } + }, + "glob": { + "version": "7.1.7", + "resolved": "https://registry.npmjs.org/glob/-/glob-7.1.7.tgz", + "integrity": "sha512-OvD9ENzPLbegENnYP5UUfJIirTg4+XwMWGaQfQTY0JenxNvvIKP3U3/tAQSPIu/lHxXYSZmpXlUHeqAIdKzBLQ==", + "requires": { + "fs.realpath": "^1.0.0", + "inflight": "^1.0.4", + "inherits": "2", + "minimatch": "^3.0.4", + "once": "^1.3.0", + "path-is-absolute": "^1.0.0" + } + }, + "glob-parent": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/glob-parent/-/glob-parent-3.1.0.tgz", + "integrity": "sha1-nmr2KZ2NO9K9QEMIMr0RPfkGxa4=", + "requires": { + "is-glob": "^3.1.0", + "path-dirname": "^1.0.0" + }, + "dependencies": { + "is-glob": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/is-glob/-/is-glob-3.1.0.tgz", + "integrity": "sha1-e6WuJCF4BKxwcHuWkiVnSGzD6Eo=", + "requires": { + "is-extglob": "^2.1.0" + } + } + } + }, + "glob-to-regexp": { + "version": "0.3.0", + "resolved": "https://registry.npmjs.org/glob-to-regexp/-/glob-to-regexp-0.3.0.tgz", + "integrity": "sha1-jFoUlNIGbFcMw7/kSWF1rMTVAqs=" + }, + "globals": { + "version": "11.12.0", + "resolved": "https://registry.npmjs.org/globals/-/globals-11.12.0.tgz", + "integrity": "sha512-WOBp/EEGUiIsJSp7wcv/y6MO+lV9UoncWqxuFfm8eBwzWNgyfBd6Gz+IeKQ9jCmyhoH99g15M3T+QaVHFjizVA==" + }, + "globby": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/globby/-/globby-6.1.0.tgz", + "integrity": "sha1-9abXDoOV4hyFj7BInWTfAkJNUGw=", + "requires": { + "array-union": "^1.0.1", + "glob": "^7.0.3", + "object-assign": "^4.0.1", + "pify": "^2.0.0", + "pinkie-promise": "^2.0.0" + }, + "dependencies": { + "pify": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/pify/-/pify-2.3.0.tgz", + "integrity": "sha1-7RQaasBDqEnqWISY59yosVMw6Qw=" + } + } + }, + "graceful-fs": { + "version": "4.2.6", + "resolved": "https://registry.npmjs.org/graceful-fs/-/graceful-fs-4.2.6.tgz", + "integrity": "sha512-nTnJ528pbqxYanhpDYsi4Rd8MAeaBA67+RZ10CM1m3bTAVFEDcd5AuA4a6W5YkGZ1iNXHzZz8T6TBKLeBuNriQ==" + }, + "grapheme-breaker": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/grapheme-breaker/-/grapheme-breaker-0.3.2.tgz", + "integrity": "sha1-W55reMODJFLSuiuxy4MPlidkEKw=", + "requires": { + "brfs": "^1.2.0", + "unicode-trie": "^0.3.1" + } + }, + "handle-thing": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/handle-thing/-/handle-thing-2.0.1.tgz", + "integrity": "sha512-9Qn4yBxelxoh2Ow62nP+Ka/kMnOXRi8BXnRaUwezLNhqelnN49xKz4F/dPP8OYLxLxq6JDtZb2i9XznUQbNPTg==" + }, + "har-schema": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/har-schema/-/har-schema-2.0.0.tgz", + "integrity": "sha1-qUwiJOvKwEeCoNkDVSHyRzW37JI=" + }, + "har-validator": { + "version": "5.1.5", + "resolved": "https://registry.npmjs.org/har-validator/-/har-validator-5.1.5.tgz", + "integrity": "sha512-nmT2T0lljbxdQZfspsno9hgrG3Uir6Ks5afism62poxqBM6sDnMEuPmzTq8XN0OEwqKLLdh1jQI3qyE66Nzb3w==", + "requires": { + "ajv": "^6.12.3", + "har-schema": "^2.0.0" + } + }, + "has": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/has/-/has-1.0.3.tgz", + "integrity": "sha512-f2dvO0VU6Oej7RkWJGrehjbzMAjFp5/VKPp5tTpWIV4JHHZK1/BxbFRtf/siA2SWTe09caDmVtYYzWEIbBS4zw==", + "requires": { + "function-bind": "^1.1.1" + } + }, + "has-ansi": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/has-ansi/-/has-ansi-2.0.0.tgz", + "integrity": "sha1-NPUEnOHs3ysGSa8+8k5F7TVBbZE=", + "requires": { + "ansi-regex": "^2.0.0" + }, + "dependencies": { + "ansi-regex": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", + "integrity": "sha1-w7M6te42DYbg5ijwRorn7yfWVN8=" + } + } + }, + "has-bigints": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/has-bigints/-/has-bigints-1.0.1.tgz", + "integrity": "sha512-LSBS2LjbNBTf6287JEbEzvJgftkF5qFkmCo9hDRpAzKhUOlJ+hx8dd4USs00SgsUNwc4617J9ki5YtEClM2ffA==" + }, + "has-flag": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-3.0.0.tgz", + "integrity": "sha1-tdRU3CGZriJWmfNGfloH87lVuv0=" + }, + "has-symbols": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/has-symbols/-/has-symbols-1.0.2.tgz", + "integrity": "sha512-chXa79rL/UC2KlX17jo3vRGz0azaWEx5tGqZg5pO3NUyEJVB17dMruQlzCCOfUvElghKcm5194+BCRvi2Rv/Gw==" + }, + "has-value": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-value/-/has-value-1.0.0.tgz", + "integrity": "sha1-GLKB2lhbHFxR3vJMkw7SmgvmsXc=", + "requires": { + "get-value": "^2.0.6", + "has-values": "^1.0.0", + "isobject": "^3.0.0" + } + }, + "has-values": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/has-values/-/has-values-1.0.0.tgz", + "integrity": "sha1-lbC2P+whRmGab+V/51Yo1aOe/k8=", + "requires": { + "is-number": "^3.0.0", + "kind-of": "^4.0.0" + }, + "dependencies": { + "kind-of": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-4.0.0.tgz", + "integrity": "sha1-IIE989cSkosgc3hpGkUGb65y3Vc=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "hash-base": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/hash-base/-/hash-base-3.1.0.tgz", + "integrity": "sha512-1nmYp/rhMDiE7AYkDw+lLwlAzz0AntGIe51F3RfFfEqyQ3feY2eI/NcwC6umIQVOASPMsWJLJScWKSSvzL9IVA==", + "requires": { + "inherits": "^2.0.4", + "readable-stream": "^3.6.0", + "safe-buffer": "^5.2.0" + }, + "dependencies": { + "readable-stream": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", + "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "requires": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + } + }, + "safe-buffer": { + "version": "5.2.1", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.2.1.tgz", + "integrity": "sha512-rp3So07KcdmmKbGvgaNxQSJr7bGVSVk5S9Eq1F+ppbRo70+YeaDxkw5Dd8NPN+GD6bjnYm2VuPuCXmpuYvmCXQ==" + } + } + }, + "hash.js": { + "version": "1.1.7", + "resolved": "https://registry.npmjs.org/hash.js/-/hash.js-1.1.7.tgz", + "integrity": "sha512-taOaskGt4z4SOANNseOviYDvjEJinIkRgmp7LbKP2YTTmVxWBl87s/uzK9r+44BclBSp2X7K1hqeNfz9JbBeXA==", + "requires": { + "inherits": "^2.0.3", + "minimalistic-assert": "^1.0.1" + } + }, + "he": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/he/-/he-1.2.0.tgz", + "integrity": "sha512-F/1DnUGPopORZi0ni+CvrCgHQ5FyEAHRLSApuYWMmrbSwoN2Mn/7k+Gl38gJnR7yyDZk6WLXwiGod1JOWNDKGw==" + }, + "hex-color-regex": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/hex-color-regex/-/hex-color-regex-1.1.0.tgz", + "integrity": "sha512-l9sfDFsuqtOqKDsQdqrMRk0U85RZc0RtOR9yPI7mRVOa4FsR/BVnZ0shmQRM96Ji99kYZP/7hn1cedc1+ApsTQ==" + }, + "hmac-drbg": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/hmac-drbg/-/hmac-drbg-1.0.1.tgz", + "integrity": "sha1-0nRXAQJabHdabFRXk+1QL8DGSaE=", + "requires": { + "hash.js": "^1.0.3", + "minimalistic-assert": "^1.0.0", + "minimalistic-crypto-utils": "^1.0.1" + } + }, + "hpack.js": { + "version": "2.1.6", + "resolved": "https://registry.npmjs.org/hpack.js/-/hpack.js-2.1.6.tgz", + "integrity": "sha1-h3dMCUnlE/QuhFdbPEVoH63ioLI=", + "requires": { + "inherits": "^2.0.1", + "obuf": "^1.0.0", + "readable-stream": "^2.0.1", + "wbuf": "^1.1.0" + } + }, + "hsl-regex": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/hsl-regex/-/hsl-regex-1.0.0.tgz", + "integrity": "sha1-1JMwx4ntgZ4nakwNJy3/owsY/m4=" + }, + "hsla-regex": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/hsla-regex/-/hsla-regex-1.0.0.tgz", + "integrity": "sha1-wc56MWjIxmFAM6S194d/OyJfnDg=" + }, + "html-encoding-sniffer": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/html-encoding-sniffer/-/html-encoding-sniffer-1.0.2.tgz", + "integrity": "sha512-71lZziiDnsuabfdYiUeWdCVyKuqwWi23L8YeIgV9jSSZHCtb6wB1BKWooH7L3tn4/FuZJMVWyNaIDr4RGmaSYw==", + "requires": { + "whatwg-encoding": "^1.0.1" + } + }, + "html-entities": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/html-entities/-/html-entities-1.4.0.tgz", + "integrity": "sha512-8nxjcBcd8wovbeKx7h3wTji4e6+rhaVuPNpMqwWgnHh+N9ToqsCs6XztWRBPQ+UtzsoMAdKZtUENoVzU/EMtZA==" + }, + "html-minifier-terser": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/html-minifier-terser/-/html-minifier-terser-5.1.1.tgz", + "integrity": "sha512-ZPr5MNObqnV/T9akshPKbVgyOqLmy+Bxo7juKCfTfnjNniTAMdy4hz21YQqoofMBJD2kdREaqPPdThoR78Tgxg==", + "requires": { + "camel-case": "^4.1.1", + "clean-css": "^4.2.3", + "commander": "^4.1.1", + "he": "^1.2.0", + "param-case": "^3.0.3", + "relateurl": "^0.2.7", + "terser": "^4.6.3" + }, + "dependencies": { + "commander": { + "version": "4.1.1", + "resolved": "https://registry.npmjs.org/commander/-/commander-4.1.1.tgz", + "integrity": "sha512-NOKm8xhkzAjzFx8B2v5OAHT+u5pRQc2UCa2Vq9jYL/31o2wi9mxBA7LIFs3sV5VSC49z6pEhfbMULvShKj26WA==" + }, + "terser": { + "version": "4.8.0", + "resolved": "https://registry.npmjs.org/terser/-/terser-4.8.0.tgz", + "integrity": "sha512-EAPipTNeWsb/3wLPeup1tVPaXfIaU68xMnVdPafIL1TV05OhASArYyIfFvnvJCNrR2NIOvDVNNTFRa+Re2MWyw==", + "requires": { + "commander": "^2.20.0", + "source-map": "~0.6.1", + "source-map-support": "~0.5.12" + }, + "dependencies": { + "commander": { + "version": "2.20.3", + "resolved": "https://registry.npmjs.org/commander/-/commander-2.20.3.tgz", + "integrity": "sha512-GpVkmM8vF2vQUkj2LvZmD35JxeJOLCwJ9cUkugyk2nuhbv3+mJvpLYYt+0+USMxE+oj+ey/lJEnhZw75x/OMcQ==" + } + } + } + } + }, + "html-tags": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/html-tags/-/html-tags-1.2.0.tgz", + "integrity": "sha1-x43mW1Zjqll5id0rerSSANfk25g=" + }, + "html-webpack-plugin": { + "version": "5.3.2", + "resolved": "https://registry.npmjs.org/html-webpack-plugin/-/html-webpack-plugin-5.3.2.tgz", + "integrity": "sha512-HvB33boVNCz2lTyBsSiMffsJ+m0YLIQ+pskblXgN9fnjS1BgEcuAfdInfXfGrkdXV406k9FiDi86eVCDBgJOyQ==", + "requires": { + "@types/html-minifier-terser": "^5.0.0", + "html-minifier-terser": "^5.0.1", + "lodash": "^4.17.21", + "pretty-error": "^3.0.4", + "tapable": "^2.0.0" + } + }, + "htmlnano": { + "version": "0.2.9", + "resolved": "https://registry.npmjs.org/htmlnano/-/htmlnano-0.2.9.tgz", + "integrity": "sha512-jWTtP3dCd7R8x/tt9DK3pvpcQd7HDMcRPUqPxr/i9989q2k5RHIhmlRDFeyQ/LSd8IKrteG8Ce5g0Ig4eGIipg==", + "requires": { + "cssnano": "^4.1.11", + "posthtml": "^0.15.1", + "purgecss": "^2.3.0", + "relateurl": "^0.2.7", + "srcset": "^3.0.0", + "svgo": "^1.3.2", + "terser": "^5.6.1", + "timsort": "^0.3.0", + "uncss": "^0.17.3" + }, + "dependencies": { + "posthtml": { + "version": "0.15.2", + "resolved": "https://registry.npmjs.org/posthtml/-/posthtml-0.15.2.tgz", + "integrity": "sha512-YugEJ5ze/0DLRIVBjCpDwANWL4pPj1kHJ/2llY8xuInr0nbkon3qTiMPe5LQa+cCwNjxS7nAZZTp+1M+6mT4Zg==", + "requires": { + "posthtml-parser": "^0.7.2", + "posthtml-render": "^1.3.1" + } + }, + "posthtml-parser": { + "version": "0.7.2", + "resolved": "https://registry.npmjs.org/posthtml-parser/-/posthtml-parser-0.7.2.tgz", + "integrity": "sha512-LjEEG/3fNcWZtBfsOE3Gbyg1Li4CmsZRkH1UmbMR7nKdMXVMYI3B4/ZMiCpaq8aI1Aym4FRMMW9SAOLSwOnNsQ==", + "requires": { + "htmlparser2": "^6.0.0" + } + }, + "source-map": { + "version": "0.7.3", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.7.3.tgz", + "integrity": "sha512-CkCj6giN3S+n9qrYiBTX5gystlENnRW5jZeNLHpe6aue+SrHcG5VYwujhW9s4dY31mEGsxBDrHR6oI69fTXsaQ==" + }, + "terser": { + "version": "5.7.0", + "resolved": "https://registry.npmjs.org/terser/-/terser-5.7.0.tgz", + "integrity": "sha512-HP5/9hp2UaZt5fYkuhNBR8YyRcT8juw8+uFbAme53iN9hblvKnLUTKkmwJG6ocWpIKf8UK4DoeWG4ty0J6S6/g==", + "requires": { + "commander": "^2.20.0", + "source-map": "~0.7.2", + "source-map-support": "~0.5.19" + } + } + } + }, + "htmlparser2": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/htmlparser2/-/htmlparser2-6.1.0.tgz", + "integrity": "sha512-gyyPk6rgonLFEDGoeRgQNaEUvdJ4ktTmmUh/h2t7s+M8oPpIPxgNACWa+6ESR57kXstwqPiCut0V8NRpcwgU7A==", + "requires": { + "domelementtype": "^2.0.1", + "domhandler": "^4.0.0", + "domutils": "^2.5.2", + "entities": "^2.0.0" + }, + "dependencies": { + "dom-serializer": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/dom-serializer/-/dom-serializer-1.3.2.tgz", + "integrity": "sha512-5c54Bk5Dw4qAxNOI1pFEizPSjVsx5+bpJKmL2kPn8JhBUq2q09tTCa3mjijun2NfK78NMouDYNMBkOrPZiS+ig==", + "requires": { + "domelementtype": "^2.0.1", + "domhandler": "^4.2.0", + "entities": "^2.0.0" + } + }, + "domelementtype": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-2.2.0.tgz", + "integrity": "sha512-DtBMo82pv1dFtUmHyr48beiuq792Sxohr+8Hm9zoxklYPfa6n0Z3Byjj2IV7bmr2IyqClnqEQhfgHJJ5QF0R5A==" + }, + "domutils": { + "version": "2.7.0", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-2.7.0.tgz", + "integrity": "sha512-8eaHa17IwJUPAiB+SoTYBo5mCdeMgdcAoXJ59m6DT1vw+5iLS3gNoqYaRowaBKtGVrOF1Jz4yDTgYKLK2kvfJg==", + "requires": { + "dom-serializer": "^1.0.1", + "domelementtype": "^2.2.0", + "domhandler": "^4.2.0" + } + } + } + }, + "http-deceiver": { + "version": "1.2.7", + "resolved": "https://registry.npmjs.org/http-deceiver/-/http-deceiver-1.2.7.tgz", + "integrity": "sha1-+nFolEq5pRnTN8sL7HKE3D5yPYc=" + }, + "http-errors": { + "version": "1.7.3", + "resolved": "https://registry.npmjs.org/http-errors/-/http-errors-1.7.3.tgz", + "integrity": "sha512-ZTTX0MWrsQ2ZAhA1cejAwDLycFsd7I7nVtnkT3Ol0aqodaKW+0CTZDQ1uBv5whptCnc8e8HeRRJxRs0kmm/Qfw==", + "requires": { + "depd": "~1.1.2", + "inherits": "2.0.4", + "setprototypeof": "1.1.1", + "statuses": ">= 1.5.0 < 2", + "toidentifier": "1.0.0" + } + }, + "http-parser-js": { + "version": "0.5.3", + "resolved": "https://registry.npmjs.org/http-parser-js/-/http-parser-js-0.5.3.tgz", + "integrity": "sha512-t7hjvef/5HEK7RWTdUzVUhl8zkEu+LlaE0IYzdMuvbSDipxBRpOn4Uhw8ZyECEa808iVT8XCjzo6xmYt4CiLZg==" + }, + "http-proxy": { + "version": "1.11.1", + "resolved": "https://registry.npmjs.org/http-proxy/-/http-proxy-1.11.1.tgz", + "integrity": "sha1-cd9VdX6ALVjqgQ3yJEAZ3aBa6F0=", + "requires": { + "eventemitter3": "1.x.x", + "requires-port": "0.x.x" + } + }, + "http-proxy-middleware": { + "version": "0.19.1", + "resolved": "https://registry.npmjs.org/http-proxy-middleware/-/http-proxy-middleware-0.19.1.tgz", + "integrity": "sha512-yHYTgWMQO8VvwNS22eLLloAkvungsKdKTLO8AJlftYIKNfJr3GK3zK0ZCfzDDGUBttdGc8xFy1mCitvNKQtC3Q==", + "requires": { + "http-proxy": "^1.17.0", + "is-glob": "^4.0.0", + "lodash": "^4.17.11", + "micromatch": "^3.1.10" + }, + "dependencies": { + "eventemitter3": { + "version": "4.0.7", + "resolved": "https://registry.npmjs.org/eventemitter3/-/eventemitter3-4.0.7.tgz", + "integrity": "sha512-8guHBZCwKnFhYdHr2ysuRWErTwhoN2X8XELRlrRwpmfeY2jjuUN4taQMsULKUVo1K4DvZl+0pgfyoysHxvmvEw==" + }, + "http-proxy": { + "version": "1.18.1", + "resolved": "https://registry.npmjs.org/http-proxy/-/http-proxy-1.18.1.tgz", + "integrity": "sha512-7mz/721AbnJwIVbnaSv1Cz3Am0ZLT/UBwkC92VlxhXv/k/BBQfM2fXElQNC27BVGr0uwUpplYPQM9LnaBMR5NQ==", + "requires": { + "eventemitter3": "^4.0.0", + "follow-redirects": "^1.0.0", + "requires-port": "^1.0.0" + } + }, + "requires-port": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/requires-port/-/requires-port-1.0.0.tgz", + "integrity": "sha1-kl0mAdOaxIXgkc8NpcbmlNw9yv8=" + } + } + }, + "http-signature": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/http-signature/-/http-signature-1.2.0.tgz", + "integrity": "sha1-muzZJRFHcvPZW2WmCruPfBj7rOE=", + "requires": { + "assert-plus": "^1.0.0", + "jsprim": "^1.2.2", + "sshpk": "^1.7.0" + } + }, + "https-browserify": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/https-browserify/-/https-browserify-1.0.0.tgz", + "integrity": "sha1-7AbBDgo0wPL68Zn3/X/Hj//QPHM=" + }, + "human-signals": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/human-signals/-/human-signals-2.1.0.tgz", + "integrity": "sha512-B4FFZ6q/T2jhhksgkbEW3HBvWIfDW85snkQgawt07S7J5QXTk6BkNV+0yAeZrM5QpMAdYlocGoljn0sJ/WQkFw==" + }, + "iconv-lite": { + "version": "0.4.24", + "resolved": "https://registry.npmjs.org/iconv-lite/-/iconv-lite-0.4.24.tgz", + "integrity": "sha512-v3MXnZAcvnywkTUEZomIActle7RXXeedOR31wwl7VlyoXO4Qi9arvSenNQWne1TcRwhCL1HwLI21bEqdpj8/rA==", + "requires": { + "safer-buffer": ">= 2.1.2 < 3" + } + }, + "icss-replace-symbols": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/icss-replace-symbols/-/icss-replace-symbols-1.1.0.tgz", + "integrity": "sha1-Bupvg2ead0njhs/h/oEq5dsiPe0=" + }, + "ieee754": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/ieee754/-/ieee754-1.2.1.tgz", + "integrity": "sha512-dcyqhDvX1C46lXZcVqCpK+FtMRQVdIMN6/Df5js2zouUsqG7I6sFxitIC+7KYK29KdXOLHdu9zL4sFnoVQnqaA==" + }, + "iferr": { + "version": "0.1.5", + "resolved": "https://registry.npmjs.org/iferr/-/iferr-0.1.5.tgz", + "integrity": "sha1-xg7taebY/bazEEofy8ocGS3FtQE=" + }, + "import-fresh": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/import-fresh/-/import-fresh-2.0.0.tgz", + "integrity": "sha1-2BNVwVYS04bGH53dOSLUMEgipUY=", + "requires": { + "caller-path": "^2.0.0", + "resolve-from": "^3.0.0" + } + }, + "import-local": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/import-local/-/import-local-3.0.2.tgz", + "integrity": "sha512-vjL3+w0oulAVZ0hBHnxa/Nm5TAurf9YLQJDhqRZyqb+VKGOB6LU8t9H1Nr5CIo16vh9XfJTOoHwU0B71S557gA==", + "requires": { + "pkg-dir": "^4.2.0", + "resolve-cwd": "^3.0.0" + } + }, + "imurmurhash": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/imurmurhash/-/imurmurhash-0.1.4.tgz", + "integrity": "sha1-khi5srkoojixPcT7a21XbyMUU+o=" + }, + "indexes-of": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/indexes-of/-/indexes-of-1.0.1.tgz", + "integrity": "sha1-8w9xbI4r00bHtn0985FVZqfAVgc=" + }, + "inflight": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/inflight/-/inflight-1.0.6.tgz", + "integrity": "sha1-Sb1jMdfQLQwJvJEKEHW6gWW1bfk=", + "requires": { + "once": "^1.3.0", + "wrappy": "1" + } + }, + "inherits": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.4.tgz", + "integrity": "sha512-k/vGaX4/Yla3WzyMCvTQOXYeIHvqOKtnqBduzTHpzpQZzAskKMhZ2K+EnBiSM9zGSoIFeMpXKxa4dYeZIQqewQ==" + }, + "ini": { + "version": "1.3.8", + "resolved": "https://registry.npmjs.org/ini/-/ini-1.3.8.tgz", + "integrity": "sha512-JV/yugV2uzW5iMRSiZAyDtQd+nxtUnjeLt0acNdw98kKLrvuRVyB80tsREOE7yvGVgalhZ6RNXCmEHkUKBKxew==" + }, + "internal-ip": { + "version": "4.3.0", + "resolved": "https://registry.npmjs.org/internal-ip/-/internal-ip-4.3.0.tgz", + "integrity": "sha512-S1zBo1D6zcsyuC6PMmY5+55YMILQ9av8lotMx447Bq6SAgo/sDK6y6uUKmuYhW7eacnIhFfsPmCNYdDzsnnDCg==", + "requires": { + "default-gateway": "^4.2.0", + "ipaddr.js": "^1.9.0" + } + }, + "interpret": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/interpret/-/interpret-2.2.0.tgz", + "integrity": "sha512-Ju0Bz/cEia55xDwUWEa8+olFpCiQoypjnQySseKtmjNrnps3P+xfpUmGr90T7yjlVJmOtybRvPXhKMbHr+fWnw==" + }, + "invariant": { + "version": "2.2.4", + "resolved": "https://registry.npmjs.org/invariant/-/invariant-2.2.4.tgz", + "integrity": "sha512-phJfQVBuaJM5raOpJjSfkiD6BpbCE4Ns//LaXl6wGYtUBY83nWS6Rf9tXm2e8VaK60JEjYldbPif/A2B1C2gNA==", + "requires": { + "loose-envify": "^1.0.0" + } + }, + "ip": { + "version": "1.1.5", + "resolved": "https://registry.npmjs.org/ip/-/ip-1.1.5.tgz", + "integrity": "sha1-vd7XARQpCCjAoDnnLvJfWq7ENUo=" + }, + "ip-regex": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/ip-regex/-/ip-regex-2.1.0.tgz", + "integrity": "sha1-+ni/XS5pE8kRzp+BnuUUa7bYROk=" + }, + "ipaddr.js": { + "version": "1.9.1", + "resolved": "https://registry.npmjs.org/ipaddr.js/-/ipaddr.js-1.9.1.tgz", + "integrity": "sha512-0KI/607xoxSToH7GjN1FfSbLoU0+btTicjsQSWQlh/hZykN8KpmMf7uYwPW3R+akZ6R/w18ZlXSHBYXiYUPO3g==" + }, + "is-absolute-url": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-absolute-url/-/is-absolute-url-2.1.0.tgz", + "integrity": "sha1-UFMN+4T8yap9vnhS6Do3uTufKqY=" + }, + "is-accessor-descriptor": { + "version": "0.1.6", + "resolved": "https://registry.npmjs.org/is-accessor-descriptor/-/is-accessor-descriptor-0.1.6.tgz", + "integrity": "sha1-qeEss66Nh2cn7u84Q/igiXtcmNY=", + "requires": { + "kind-of": "^3.0.2" + }, + "dependencies": { + "kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "is-arguments": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-arguments/-/is-arguments-1.1.0.tgz", + "integrity": "sha512-1Ij4lOMPl/xB5kBDn7I+b2ttPMKa8szhEIrXDuXQD/oe3HJLTLhqhgGspwgyGd6MOywBUqVvYicF72lkgDnIHg==", + "requires": { + "call-bind": "^1.0.0" + } + }, + "is-arrayish": { + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/is-arrayish/-/is-arrayish-0.2.1.tgz", + "integrity": "sha1-d8mYQFJ6qOyxqLppe4BkWnqSap0=" + }, + "is-bigint": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-bigint/-/is-bigint-1.0.2.tgz", + "integrity": "sha512-0JV5+SOCQkIdzjBK9buARcV804Ddu7A0Qet6sHi3FimE9ne6m4BGQZfRn+NZiXbBk4F4XmHfDZIipLj9pX8dSA==" + }, + "is-binary-path": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/is-binary-path/-/is-binary-path-1.0.1.tgz", + "integrity": "sha1-dfFmQrSA8YenEcgUFh/TpKdlWJg=", + "requires": { + "binary-extensions": "^1.0.0" + } + }, + "is-boolean-object": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/is-boolean-object/-/is-boolean-object-1.1.1.tgz", + "integrity": "sha512-bXdQWkECBUIAcCkeH1unwJLIpZYaa5VvuygSyS/c2lf719mTKZDU5UdDRlpd01UjADgmW8RfqaP+mRaVPdr/Ng==", + "requires": { + "call-bind": "^1.0.2" + } + }, + "is-buffer": { + "version": "1.1.6", + "resolved": "https://registry.npmjs.org/is-buffer/-/is-buffer-1.1.6.tgz", + "integrity": "sha512-NcdALwpXkTm5Zvvbk7owOUSvVvBKDgKP5/ewfXEznmQFfs4ZRmanOeKBTjRVjka3QFoN6XJ+9F3USqfHqTaU5w==" + }, + "is-callable": { + "version": "1.2.3", + "resolved": "https://registry.npmjs.org/is-callable/-/is-callable-1.2.3.tgz", + "integrity": "sha512-J1DcMe8UYTBSrKezuIUTUwjXsho29693unXM2YhJUTR2txK/eG47bvNa/wipPFmZFgr/N6f1GA66dv0mEyTIyQ==" + }, + "is-color-stop": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-color-stop/-/is-color-stop-1.1.0.tgz", + "integrity": "sha1-z/9HGu5N1cnhWFmPvhKWe1za00U=", + "requires": { + "css-color-names": "^0.0.4", + "hex-color-regex": "^1.1.0", + "hsl-regex": "^1.0.0", + "hsla-regex": "^1.0.0", + "rgb-regex": "^1.0.1", + "rgba-regex": "^1.0.0" + } + }, + "is-core-module": { + "version": "2.4.0", + "resolved": "https://registry.npmjs.org/is-core-module/-/is-core-module-2.4.0.tgz", + "integrity": "sha512-6A2fkfq1rfeQZjxrZJGerpLCTHRNEBiSgnu0+obeJpEPZRUooHgsizvzv0ZjJwOz3iWIHdJtVWJ/tmPr3D21/A==", + "requires": { + "has": "^1.0.3" + } + }, + "is-data-descriptor": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/is-data-descriptor/-/is-data-descriptor-0.1.4.tgz", + "integrity": "sha1-C17mSDiOLIYCgueT8YVv7D8wG1Y=", + "requires": { + "kind-of": "^3.0.2" + }, + "dependencies": { + "kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "is-date-object": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/is-date-object/-/is-date-object-1.0.4.tgz", + "integrity": "sha512-/b4ZVsG7Z5XVtIxs/h9W8nvfLgSAyKYdtGWQLbqy6jA1icmgjf8WCoTKgeS4wy5tYaPePouzFMANbnj94c2Z+A==" + }, + "is-descriptor": { + "version": "0.1.6", + "resolved": "https://registry.npmjs.org/is-descriptor/-/is-descriptor-0.1.6.tgz", + "integrity": "sha512-avDYr0SB3DwO9zsMov0gKCESFYqCnE4hq/4z3TdUlukEy5t9C0YRq7HLrsN52NAcqXKaepeCD0n+B0arnVG3Hg==", + "requires": { + "is-accessor-descriptor": "^0.1.6", + "is-data-descriptor": "^0.1.4", + "kind-of": "^5.0.0" + }, + "dependencies": { + "kind-of": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-5.1.0.tgz", + "integrity": "sha512-NGEErnH6F2vUuXDh+OlbcKW7/wOcfdRHaZ7VWtqCztfHri/++YKmP51OdWeGPuqCOba6kk2OTe5d02VmTB80Pw==" + } + } + }, + "is-directory": { + "version": "0.3.1", + "resolved": "https://registry.npmjs.org/is-directory/-/is-directory-0.3.1.tgz", + "integrity": "sha1-YTObbyR1/Hcv2cnYP1yFddwVSuE=" + }, + "is-extendable": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/is-extendable/-/is-extendable-0.1.1.tgz", + "integrity": "sha1-YrEQ4omkcUGOPsNqYX1HLjAd/Ik=" + }, + "is-extglob": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/is-extglob/-/is-extglob-2.1.1.tgz", + "integrity": "sha1-qIwCU1eR8C7TfHahueqXc8gz+MI=" + }, + "is-fullwidth-code-point": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/is-fullwidth-code-point/-/is-fullwidth-code-point-2.0.0.tgz", + "integrity": "sha1-o7MKXE8ZkYMWeqq5O+764937ZU8=" + }, + "is-glob": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/is-glob/-/is-glob-4.0.1.tgz", + "integrity": "sha512-5G0tKtBTFImOqDnLB2hG6Bp2qcKEFduo4tZu9MT/H6NQv/ghhy30o55ufafxJ/LdH79LLs2Kfrn85TLKyA7BUg==", + "requires": { + "is-extglob": "^2.1.1" + } + }, + "is-html": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-html/-/is-html-1.1.0.tgz", + "integrity": "sha1-4E8cGNOUhRETlvmgJz6rUa8hhGQ=", + "requires": { + "html-tags": "^1.0.0" + } + }, + "is-negative-zero": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/is-negative-zero/-/is-negative-zero-2.0.1.tgz", + "integrity": "sha512-2z6JzQvZRa9A2Y7xC6dQQm4FSTSTNWjKIYYTt4246eMTJmIo0Q+ZyOsU66X8lxK1AbB92dFeglPLrhwpeRKO6w==" + }, + "is-number": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/is-number/-/is-number-3.0.0.tgz", + "integrity": "sha1-JP1iAaR4LPUFYcgQJ2r8fRLXEZU=", + "requires": { + "kind-of": "^3.0.2" + }, + "dependencies": { + "kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "is-number-object": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/is-number-object/-/is-number-object-1.0.5.tgz", + "integrity": "sha512-RU0lI/n95pMoUKu9v1BZP5MBcZuNSVJkMkAG2dJqC4z2GlkGUNeH68SuHuBKBD/XFe+LHZ+f9BKkLET60Niedw==" + }, + "is-obj": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/is-obj/-/is-obj-2.0.0.tgz", + "integrity": "sha512-drqDG3cbczxxEJRoOXcOjtdp1J/lyp1mNn0xaznRs8+muBhgQcrnbspox5X5fOw0HnMnbfDzvnEMEtqDEJEo8w==" + }, + "is-path-cwd": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/is-path-cwd/-/is-path-cwd-2.2.0.tgz", + "integrity": "sha512-w942bTcih8fdJPJmQHFzkS76NEP8Kzzvmw92cXsazb8intwLqPibPPdXf4ANdKV3rYMuuQYGIWtvz9JilB3NFQ==" + }, + "is-path-in-cwd": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-path-in-cwd/-/is-path-in-cwd-2.1.0.tgz", + "integrity": "sha512-rNocXHgipO+rvnP6dk3zI20RpOtrAM/kzbB258Uw5BWr3TpXi861yzjo16Dn4hUox07iw5AyeMLHWsujkjzvRQ==", + "requires": { + "is-path-inside": "^2.1.0" + } + }, + "is-path-inside": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-path-inside/-/is-path-inside-2.1.0.tgz", + "integrity": "sha512-wiyhTzfDWsvwAW53OBWF5zuvaOGlZ6PwYxAbPVDhpm+gM09xKQGjBq/8uYN12aDvMxnAnq3dxTyoSoRNmg5YFg==", + "requires": { + "path-is-inside": "^1.0.2" + } + }, + "is-plain-obj": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/is-plain-obj/-/is-plain-obj-2.1.0.tgz", + "integrity": "sha512-YWnfyRwxL/+SsrWYfOpUtz5b3YD+nyfkHvjbcanzk8zgyO4ASD67uVMRt8k5bM4lLMDnXfriRhOpemw+NfT1eA==" + }, + "is-plain-object": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/is-plain-object/-/is-plain-object-2.0.4.tgz", + "integrity": "sha512-h5PpgXkWitc38BBMYawTYMWJHFZJVnBquFE57xFpjB8pJFiF6gZ+bU+WyI/yqXiFR5mdLsgYNaPe8uao6Uv9Og==", + "requires": { + "isobject": "^3.0.1" + } + }, + "is-regex": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/is-regex/-/is-regex-1.1.3.tgz", + "integrity": "sha512-qSVXFz28HM7y+IWX6vLCsexdlvzT1PJNFSBuaQLQ5o0IEw8UDYW6/2+eCMVyIsbM8CNLX2a/QWmSpyxYEHY7CQ==", + "requires": { + "call-bind": "^1.0.2", + "has-symbols": "^1.0.2" + } + }, + "is-resolvable": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-resolvable/-/is-resolvable-1.1.0.tgz", + "integrity": "sha512-qgDYXFSR5WvEfuS5dMj6oTMEbrrSaM0CrFk2Yiq/gXnBvD9pMa2jGXxyhGLfvhZpuMZe18CJpFxAt3CRs42NMg==" + }, + "is-stream": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/is-stream/-/is-stream-2.0.0.tgz", + "integrity": "sha512-XCoy+WlUr7d1+Z8GgSuXmpuUFC9fOhRXglJMx+dwLKTkL44Cjd4W1Z5P+BQZpr+cR93aGP4S/s7Ftw6Nd/kiEw==" + }, + "is-string": { + "version": "1.0.6", + "resolved": "https://registry.npmjs.org/is-string/-/is-string-1.0.6.tgz", + "integrity": "sha512-2gdzbKUuqtQ3lYNrUTQYoClPhm7oQu4UdpSZMp1/DGgkHBT8E2Z1l0yMdb6D4zNAxwDiMv8MdulKROJGNl0Q0w==" + }, + "is-symbol": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/is-symbol/-/is-symbol-1.0.4.tgz", + "integrity": "sha512-C/CPBqKWnvdcxqIARxyOh4v1UUEOCHpgDa0WYgpKDFMszcrPcffg5uhwSgPCLD2WWxmq6isisz87tzT01tuGhg==", + "requires": { + "has-symbols": "^1.0.2" + } + }, + "is-typedarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-typedarray/-/is-typedarray-1.0.0.tgz", + "integrity": "sha1-5HnICFjfDBsR3dppQPlgEfzaSpo=" + }, + "is-url": { + "version": "1.2.4", + "resolved": "https://registry.npmjs.org/is-url/-/is-url-1.2.4.tgz", + "integrity": "sha512-ITvGim8FhRiYe4IQ5uHSkj7pVaPDrCTkNd3yq3cV7iZAcJdHTUMPMEHcqSOy9xZ9qFenQCvi+2wjH9a1nXqHww==" + }, + "is-windows": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-windows/-/is-windows-1.0.2.tgz", + "integrity": "sha512-eXK1UInq2bPmjyX6e3VHIzMLobc4J94i4AWn+Hpq3OU5KkrRC96OAcR3PRJ/pGu6m8TRnBHP9dkXQVsT/COVIA==" + }, + "is-wsl": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/is-wsl/-/is-wsl-1.1.0.tgz", + "integrity": "sha1-HxbkqiKwTRM2tmGIpmrzxgDDpm0=" + }, + "isarray": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/isarray/-/isarray-1.0.0.tgz", + "integrity": "sha1-u5NdSFgsuhaMBoNJV6VKPgcSTxE=" + }, + "isexe": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/isexe/-/isexe-2.0.0.tgz", + "integrity": "sha1-6PvzdNxVb/iUehDcsFctYz8s+hA=" + }, + "isobject": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/isobject/-/isobject-3.0.1.tgz", + "integrity": "sha1-TkMekrEalzFjaqH5yNHMvP2reN8=" + }, + "isstream": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/isstream/-/isstream-0.1.2.tgz", + "integrity": "sha1-R+Y/evVa+m+S4VAOaQ64uFKcCZo=" + }, + "jest-worker": { + "version": "27.0.2", + "resolved": "https://registry.npmjs.org/jest-worker/-/jest-worker-27.0.2.tgz", + "integrity": "sha512-EoBdilOTTyOgmHXtw/cPc+ZrCA0KJMrkXzkrPGNwLmnvvlN1nj7MPrxpT7m+otSv2e1TLaVffzDnE/LB14zJMg==", + "requires": { + "@types/node": "*", + "merge-stream": "^2.0.0", + "supports-color": "^8.0.0" + }, + "dependencies": { + "has-flag": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/has-flag/-/has-flag-4.0.0.tgz", + "integrity": "sha512-EykJT/Q1KjTWctppgIAgfSO0tKVuZUjhgMr17kqTumMl6Afv3EISleU7qZUzoXDFTAHTDC4NOoG/ZxU3EvlMPQ==" + }, + "supports-color": { + "version": "8.1.1", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-8.1.1.tgz", + "integrity": "sha512-MpUEN2OodtUzxvKQl72cUF7RQ5EiHsGvSsVG0ia9c5RbWGL2CI4C7EpPS8UTBIplnlzZiNuV56w+FuNxy3ty2Q==", + "requires": { + "has-flag": "^4.0.0" + } + } + } + }, + "js-beautify": { + "version": "1.14.0", + "resolved": "https://registry.npmjs.org/js-beautify/-/js-beautify-1.14.0.tgz", + "integrity": "sha512-yuck9KirNSCAwyNJbqW+BxJqJ0NLJ4PwBUzQQACl5O3qHMBXVkXb/rD0ilh/Lat/tn88zSZ+CAHOlk0DsY7GuQ==", + "requires": { + "config-chain": "^1.1.12", + "editorconfig": "^0.15.3", + "glob": "^7.1.3", + "nopt": "^5.0.0" + } + }, + "js-levenshtein": { + "version": "1.1.6", + "resolved": "https://registry.npmjs.org/js-levenshtein/-/js-levenshtein-1.1.6.tgz", + "integrity": "sha512-X2BB11YZtrRqY4EnQcLX5Rh373zbK4alC1FW7D7MBhL2gtcC17cTnr6DmfHZeS0s2rTHjUTMMHfG7gO8SSdw+g==" + }, + "js-string-escape": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/js-string-escape/-/js-string-escape-1.0.1.tgz", + "integrity": "sha1-4mJbrbwNZ8dTPp7cEGjFh65BN+8=" + }, + "js-tokens": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/js-tokens/-/js-tokens-4.0.0.tgz", + "integrity": "sha512-RdJUflcE3cUzKiMqQgsCu06FPu9UdIJO0beYbPhHN4k6apgJtifcoCtT9bcxOpYBtpD2kCM6Sbzg4CausW/PKQ==" + }, + "js-yaml": { + "version": "3.14.1", + "resolved": "https://registry.npmjs.org/js-yaml/-/js-yaml-3.14.1.tgz", + "integrity": "sha512-okMH7OXXJ7YrN9Ok3/SXrnu4iX9yOk+25nqX4imS2npuvTYDmo/QEZoqwZkYaIDk3jVvBOTOIEgEhaLOynBS9g==", + "requires": { + "argparse": "^1.0.7", + "esprima": "^4.0.0" + }, + "dependencies": { + "esprima": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/esprima/-/esprima-4.0.1.tgz", + "integrity": "sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==" + } + } + }, + "jsbn": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/jsbn/-/jsbn-0.1.1.tgz", + "integrity": "sha1-peZUwuWi3rXyAdls77yoDA7y9RM=" + }, + "jsdom": { + "version": "14.1.0", + "resolved": "https://registry.npmjs.org/jsdom/-/jsdom-14.1.0.tgz", + "integrity": "sha512-O901mfJSuTdwU2w3Sn+74T+RnDVP+FuV5fH8tcPWyqrseRAb0s5xOtPgCFiPOtLcyK7CLIJwPyD83ZqQWvA5ng==", + "requires": { + "abab": "^2.0.0", + "acorn": "^6.0.4", + "acorn-globals": "^4.3.0", + "array-equal": "^1.0.0", + "cssom": "^0.3.4", + "cssstyle": "^1.1.1", + "data-urls": "^1.1.0", + "domexception": "^1.0.1", + "escodegen": "^1.11.0", + "html-encoding-sniffer": "^1.0.2", + "nwsapi": "^2.1.3", + "parse5": "5.1.0", + "pn": "^1.1.0", + "request": "^2.88.0", + "request-promise-native": "^1.0.5", + "saxes": "^3.1.9", + "symbol-tree": "^3.2.2", + "tough-cookie": "^2.5.0", + "w3c-hr-time": "^1.0.1", + "w3c-xmlserializer": "^1.1.2", + "webidl-conversions": "^4.0.2", + "whatwg-encoding": "^1.0.5", + "whatwg-mimetype": "^2.3.0", + "whatwg-url": "^7.0.0", + "ws": "^6.1.2", + "xml-name-validator": "^3.0.0" + }, + "dependencies": { + "acorn": { + "version": "6.4.2", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-6.4.2.tgz", + "integrity": "sha512-XtGIhXwF8YM8bJhGxG5kXgjkEuNGLTkoYqVE+KMR+aspr4KGYmKYg7yUe3KghyQ9yheNwLnjmzh/7+gfDBmHCQ==" + }, + "escodegen": { + "version": "1.14.3", + "resolved": "https://registry.npmjs.org/escodegen/-/escodegen-1.14.3.tgz", + "integrity": "sha512-qFcX0XJkdg+PB3xjZZG/wKSuT1PnQWx57+TVSjIMmILd2yC/6ByYElPwJnslDsuWuSAp4AwJGumarAAmJch5Kw==", + "requires": { + "esprima": "^4.0.1", + "estraverse": "^4.2.0", + "esutils": "^2.0.2", + "optionator": "^0.8.1", + "source-map": "~0.6.1" + } + }, + "esprima": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/esprima/-/esprima-4.0.1.tgz", + "integrity": "sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==" + }, + "ws": { + "version": "6.2.2", + "resolved": "https://registry.npmjs.org/ws/-/ws-6.2.2.tgz", + "integrity": "sha512-zmhltoSR8u1cnDsD43TX59mzoMZsLKqUweyYBAIvTngR3shc0W6aOZylZmq/7hqyVxPdi+5Ud2QInblgyE72fw==", + "requires": { + "async-limiter": "~1.0.0" + } + } + } + }, + "jsesc": { + "version": "2.5.2", + "resolved": "https://registry.npmjs.org/jsesc/-/jsesc-2.5.2.tgz", + "integrity": "sha512-OYu7XEzjkCQ3C5Ps3QIZsQfNpqoJyZZA99wd9aWd05NCtC5pWOkShK2mkL6HXQR6/Cy2lbNdPlZBpuQHXE63gA==" + }, + "json-parse-better-errors": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/json-parse-better-errors/-/json-parse-better-errors-1.0.2.tgz", + "integrity": "sha512-mrqyZKfX5EhL7hvqcV6WG1yYjnjeuYDzDhhcAAUrq8Po85NBQBJP+ZDUT75qZQ98IkUoBqdkExkukOU7Ts2wrw==" + }, + "json-schema": { + "version": "0.2.3", + "resolved": "https://registry.npmjs.org/json-schema/-/json-schema-0.2.3.tgz", + "integrity": "sha1-tIDIkuWaLwWVTOcnvT8qTogvnhM=" + }, + "json-schema-traverse": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/json-schema-traverse/-/json-schema-traverse-0.4.1.tgz", + "integrity": "sha512-xbbCH5dCYU5T8LcEhhuh7HJ88HXuW3qsI3Y0zOZFKfZEHcpWiHU/Jxzk629Brsab/mMiHQti9wMP+845RPe3Vg==" + }, + "json-stringify-safe": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/json-stringify-safe/-/json-stringify-safe-5.0.1.tgz", + "integrity": "sha1-Epai1Y/UXxmg9s4B1lcB4sc1tus=" + }, + "json3": { + "version": "3.3.3", + "resolved": "https://registry.npmjs.org/json3/-/json3-3.3.3.tgz", + "integrity": "sha512-c7/8mbUsKigAbLkD5B010BK4D9LZm7A1pNItkEwiUZRpIN66exu/e7YQWysGun+TRKaJp8MhemM+VkfWv42aCA==" + }, + "json5": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/json5/-/json5-1.0.1.tgz", + "integrity": "sha512-aKS4WQjPenRxiQsC93MNfjx+nbF4PAdYzmd/1JIj8HYzqfbu86beTuNgXDzPknWk0n0uARlyewZo4s++ES36Ow==", + "requires": { + "minimist": "^1.2.0" + } + }, + "jsprim": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/jsprim/-/jsprim-1.4.1.tgz", + "integrity": "sha1-MT5mvB5cwG5Di8G3SZwuXFastqI=", + "requires": { + "assert-plus": "1.0.0", + "extsprintf": "1.3.0", + "json-schema": "0.2.3", + "verror": "1.10.0" + } + }, + "killable": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/killable/-/killable-1.0.1.tgz", + "integrity": "sha512-LzqtLKlUwirEUyl/nicirVmNiPvYs7l5n8wOPP7fyJVpUPkvCnW/vuiXGpylGUlnPDnB7311rARzAt3Mhswpjg==" + }, + "kind-of": { + "version": "6.0.3", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-6.0.3.tgz", + "integrity": "sha512-dcS1ul+9tmeD95T+x28/ehLgd9mENa3LsvDTtzm3vyBEO7RPptvAD+t44WVXaUjTBRcrpFeFlC8WCruUR456hw==" + }, + "levn": { + "version": "0.3.0", + "resolved": "https://registry.npmjs.org/levn/-/levn-0.3.0.tgz", + "integrity": "sha1-OwmSTt+fCDwEkP3UwLxEIeBHZO4=", + "requires": { + "prelude-ls": "~1.1.2", + "type-check": "~0.3.2" + } + }, + "loader-runner": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/loader-runner/-/loader-runner-4.2.0.tgz", + "integrity": "sha512-92+huvxMvYlMzMt0iIOukcwYBFpkYJdpl2xsZ7LrlayO7E8SOv+JJUEK17B/dJIHAOLMfh2dZZ/Y18WgmGtYNw==" + }, + "loader-utils": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/loader-utils/-/loader-utils-1.4.0.tgz", + "integrity": "sha512-qH0WSMBtn/oHuwjy/NucEgbx5dbxxnxup9s4PVXJUDHZBQY+s0NWA9rJf53RBnQZxfch7euUui7hpoAPvALZdA==", + "requires": { + "big.js": "^5.2.2", + "emojis-list": "^3.0.0", + "json5": "^1.0.1" + } + }, + "locate-path": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-5.0.0.tgz", + "integrity": "sha512-t7hw9pI+WvuwNJXwk5zVHpyhIqzg2qTlklJOf0mVxGSbe3Fp2VieZcduNYjaLDoy6p9uGpQEGWG87WpMKlNq8g==", + "requires": { + "p-locate": "^4.1.0" + } + }, + "lodash": { + "version": "4.17.21", + "resolved": "https://registry.npmjs.org/lodash/-/lodash-4.17.21.tgz", + "integrity": "sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg==" + }, + "lodash.clone": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.clone/-/lodash.clone-4.5.0.tgz", + "integrity": "sha1-GVhwRQ9aExkkeN9Lw9I9LeoZB7Y=" + }, + "lodash.difference": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.difference/-/lodash.difference-4.5.0.tgz", + "integrity": "sha1-nMtOUF1Ia5FlE0V3KIWi3yf9AXw=" + }, + "lodash.memoize": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/lodash.memoize/-/lodash.memoize-4.1.2.tgz", + "integrity": "sha1-vMbEmkKihA7Zl/Mj6tpezRguC/4=" + }, + "lodash.sortby": { + "version": "4.7.0", + "resolved": "https://registry.npmjs.org/lodash.sortby/-/lodash.sortby-4.7.0.tgz", + "integrity": "sha1-7dFMgk4sycHgsKG0K7UhBRakJDg=" + }, + "lodash.uniq": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.uniq/-/lodash.uniq-4.5.0.tgz", + "integrity": "sha1-0CJTc662Uq3BvILklFM5qEJ1R3M=" + }, + "log-symbols": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/log-symbols/-/log-symbols-2.2.0.tgz", + "integrity": "sha512-VeIAFslyIerEJLXHziedo2basKbMKtTw3vfn5IzG0XTjhAVEJyNHnL2p7vc+wBDSdQuUpNw3M2u6xb9QsAY5Eg==", + "requires": { + "chalk": "^2.0.1" + } + }, + "log-update": { + "version": "3.4.0", + "resolved": "https://registry.npmjs.org/log-update/-/log-update-3.4.0.tgz", + "integrity": "sha512-ILKe88NeMt4gmDvk/eb615U/IVn7K9KWGkoYbdatQ69Z65nj1ZzjM6fHXfcs0Uge+e+EGnMW7DY4T9yko8vWFg==", + "requires": { + "ansi-escapes": "^3.2.0", + "cli-cursor": "^2.1.0", + "wrap-ansi": "^5.0.0" + } + }, + "loglevel": { + "version": "1.7.1", + "resolved": "https://registry.npmjs.org/loglevel/-/loglevel-1.7.1.tgz", + "integrity": "sha512-Hesni4s5UkWkwCGJMQGAh71PaLUmKFM60dHvq0zi/vDhhrzuk+4GgNbTXJ12YYQJn6ZKBDNIjYcuQGKudvqrIw==" + }, + "loose-envify": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/loose-envify/-/loose-envify-1.4.0.tgz", + "integrity": "sha512-lyuxPGr/Wfhrlem2CL/UcnUc1zcqKAImBDzukY7Y5F/yQiNdko6+fRLevlw1HgMySw7f611UIY408EtxRSoK3Q==", + "requires": { + "js-tokens": "^3.0.0 || ^4.0.0" + } + }, + "lower-case": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/lower-case/-/lower-case-2.0.2.tgz", + "integrity": "sha512-7fm3l3NAF9WfN6W3JOmf5drwpVqX78JtoGJ3A6W0a6ZnldM41w2fV5D490psKFTpMds8TJse/eHLFFsNHHjHgg==", + "requires": { + "tslib": "^2.0.3" + } + }, + "lru-cache": { + "version": "4.1.5", + "resolved": "https://registry.npmjs.org/lru-cache/-/lru-cache-4.1.5.tgz", + "integrity": "sha512-sWZlbEP2OsHNkXrMl5GYk/jKk70MBng6UU4YI/qGDYbgf6YbP4EvmqISbXCoJiRKs+1bSpFHVgQxvJ17F2li5g==", + "requires": { + "pseudomap": "^1.0.2", + "yallist": "^2.1.2" + } + }, + "magic-string": { + "version": "0.22.5", + "resolved": "https://registry.npmjs.org/magic-string/-/magic-string-0.22.5.tgz", + "integrity": "sha512-oreip9rJZkzvA8Qzk9HFs8fZGF/u7H/gtrE8EN6RjKJ9kh2HlC+yQ2QezifqTZfGyiuAV0dRv5a+y/8gBb1m9w==", + "requires": { + "vlq": "^0.2.2" + } + }, + "map-cache": { + "version": "0.2.2", + "resolved": "https://registry.npmjs.org/map-cache/-/map-cache-0.2.2.tgz", + "integrity": "sha1-wyq9C9ZSXZsFFkW7TyasXcmKDb8=" + }, + "map-visit": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/map-visit/-/map-visit-1.0.0.tgz", + "integrity": "sha1-7Nyo8TFE5mDxtb1B8S80edmN+48=", + "requires": { + "object-visit": "^1.0.0" + } + }, + "md5.js": { + "version": "1.3.5", + "resolved": "https://registry.npmjs.org/md5.js/-/md5.js-1.3.5.tgz", + "integrity": "sha512-xitP+WxNPcTTOgnTJcrhM0xvdPepipPSf3I8EIpGKeFLjt3PlJLIDG3u8EX53ZIubkb+5U2+3rELYpEhHhzdkg==", + "requires": { + "hash-base": "^3.0.0", + "inherits": "^2.0.1", + "safe-buffer": "^5.1.2" + } + }, + "mdn-data": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/mdn-data/-/mdn-data-2.0.4.tgz", + "integrity": "sha512-iV3XNKw06j5Q7mi6h+9vbx23Tv7JkjEVgKHW4pimwyDGWm0OIQntJJ+u1C6mg6mK1EaTv42XQ7w76yuzH7M2cA==" + }, + "media-typer": { + "version": "0.3.0", + "resolved": "https://registry.npmjs.org/media-typer/-/media-typer-0.3.0.tgz", + "integrity": "sha1-hxDXrwqmJvj/+hzgAWhUUmMlV0g=" + }, + "memory-fs": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/memory-fs/-/memory-fs-0.4.1.tgz", + "integrity": "sha1-OpoguEYlI+RHz7x+i7gO1me/xVI=", + "requires": { + "errno": "^0.1.3", + "readable-stream": "^2.0.1" + } + }, + "merge-descriptors": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/merge-descriptors/-/merge-descriptors-1.0.1.tgz", + "integrity": "sha1-sAqqVW3YtEVoFQ7J0blT8/kMu2E=" + }, + "merge-source-map": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/merge-source-map/-/merge-source-map-1.0.4.tgz", + "integrity": "sha1-pd5GU42uhNQRTMXqArR3KmNGcB8=", + "requires": { + "source-map": "^0.5.6" + }, + "dependencies": { + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "merge-stream": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/merge-stream/-/merge-stream-2.0.0.tgz", + "integrity": "sha512-abv/qOcuPfk3URPfDzmZU1LKmuw8kT+0nIHvKrKgFrwifol/doWcdA4ZqsWQ8ENrFKkd67Mfpo/LovbIUsbt3w==" + }, + "merge2": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/merge2/-/merge2-1.4.1.tgz", + "integrity": "sha512-8q7VEgMJW4J8tcfVPy8g09NcQwZdbwFEqhe/WZkoIzjn/3TGDwtOCYtXGxA3O8tPzpczCCDgv+P2P5y00ZJOOg==" + }, + "methods": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/methods/-/methods-1.1.2.tgz", + "integrity": "sha1-VSmk1nZUE07cxSZmVoNbD4Ua/O4=" + }, + "micromatch": { + "version": "3.1.10", + "resolved": "https://registry.npmjs.org/micromatch/-/micromatch-3.1.10.tgz", + "integrity": "sha512-MWikgl9n9M3w+bpsY3He8L+w9eF9338xRl8IAO5viDizwSzziFEyUzo2xrrloB64ADbTf8uA8vRqqttDTOmccg==", + "requires": { + "arr-diff": "^4.0.0", + "array-unique": "^0.3.2", + "braces": "^2.3.1", + "define-property": "^2.0.2", + "extend-shallow": "^3.0.2", + "extglob": "^2.0.4", + "fragment-cache": "^0.2.1", + "kind-of": "^6.0.2", + "nanomatch": "^1.2.9", + "object.pick": "^1.3.0", + "regex-not": "^1.0.0", + "snapdragon": "^0.8.1", + "to-regex": "^3.0.2" + } + }, + "miller-rabin": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/miller-rabin/-/miller-rabin-4.0.1.tgz", + "integrity": "sha512-115fLhvZVqWwHPbClyntxEVfVDfl9DLLTuJvq3g2O/Oxi8AiNouAHvDSzHS0viUJc+V5vm3eq91Xwqn9dp4jRA==", + "requires": { + "bn.js": "^4.0.0", + "brorand": "^1.0.1" + }, + "dependencies": { + "bn.js": { + "version": "4.12.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.0.tgz", + "integrity": "sha512-c98Bf3tPniI+scsdk237ku1Dc3ujXQTSgyiPUDEOe7tRkhrqridvh8klBv0HCEso1OLOYcHuCv/cS6DNxKH+ZA==" + } + } + }, + "mime": { + "version": "1.6.0", + "resolved": "https://registry.npmjs.org/mime/-/mime-1.6.0.tgz", + "integrity": "sha512-x0Vn8spI+wuJ1O6S7gnbaQg8Pxh4NNHb7KSINmEWKiPE4RKOplvijn+NkmYmmRgP68mc70j2EbeTFRsrswaQeg==" + }, + "mime-db": { + "version": "1.48.0", + "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.48.0.tgz", + "integrity": "sha512-FM3QwxV+TnZYQ2aRqhlKBMHxk10lTbMt3bBkMAp54ddrNeVSfcQYOOKuGuy3Ddrm38I04If834fOUSq1yzslJQ==" + }, + "mime-types": { + "version": "2.1.31", + "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.31.tgz", + "integrity": "sha512-XGZnNzm3QvgKxa8dpzyhFTHmpP3l5YNusmne07VUOXxou9CqUqYa/HBy124RqtVh/O2pECas/MOcsDgpilPOPg==", + "requires": { + "mime-db": "1.48.0" + } + }, + "mimic-fn": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-1.2.0.tgz", + "integrity": "sha512-jf84uxzwiuiIVKiOLpfYk7N46TSy8ubTonmneY9vrpHNAnp0QBt2BxWV9dO3/j+BoVAb+a5G6YDPW3M5HOdMWQ==" + }, + "minimalistic-assert": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/minimalistic-assert/-/minimalistic-assert-1.0.1.tgz", + "integrity": "sha512-UtJcAD4yEaGtjPezWuO9wC4nwUnVH/8/Im3yEHQP4b67cXlD/Qr9hdITCU1xDbSEXg2XKNaP8jsReV7vQd00/A==" + }, + "minimalistic-crypto-utils": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/minimalistic-crypto-utils/-/minimalistic-crypto-utils-1.0.1.tgz", + "integrity": "sha1-9sAMHAsIIkblxNmd+4x8CDsrWCo=" + }, + "minimatch": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/minimatch/-/minimatch-3.0.4.tgz", + "integrity": "sha512-yJHVQEhyqPLUTgt9B83PXu6W3rx4MvvHvSUvToogpwoGDOUQ+yDrR0HRot+yOCdCO7u4hX3pWft6kWBBcqh0UA==", + "requires": { + "brace-expansion": "^1.1.7" + } + }, + "minimist": { + "version": "1.2.5", + "resolved": "https://registry.npmjs.org/minimist/-/minimist-1.2.5.tgz", + "integrity": "sha512-FM9nNUYrRBAELZQT3xeZQ7fmMOBg6nWNmJKTcgsJeaLstP/UODVpGsr5OhXhhXg6f+qtJ8uiZ+PUxkDWcgIXLw==" + }, + "minipass": { + "version": "2.9.0", + "resolved": "https://registry.npmjs.org/minipass/-/minipass-2.9.0.tgz", + "integrity": "sha512-wxfUjg9WebH+CUDX/CdbRlh5SmfZiy/hpkxaRI16Y9W56Pa75sWgd/rvFilSgrauD9NyFymP/+JFV3KwzIsJeg==", + "requires": { + "safe-buffer": "^5.1.2", + "yallist": "^3.0.0" + }, + "dependencies": { + "yallist": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/yallist/-/yallist-3.1.1.tgz", + "integrity": "sha512-a4UGQaWPH59mOXUYnAG2ewncQS4i4F43Tv3JoAM+s2VDAmS9NsK8GpDMLrCHPksFT7h3K6TOoUNn2pb7RoXx4g==" + } + } + }, + "minizlib": { + "version": "1.3.3", + "resolved": "https://registry.npmjs.org/minizlib/-/minizlib-1.3.3.tgz", + "integrity": "sha512-6ZYMOEnmVsdCeTJVE0W9ZD+pVnE8h9Hma/iOwwRDsdQoePpoX56/8B6z3P9VNwppJuBKNRuFDRNRqRWexT9G9Q==", + "requires": { + "minipass": "^2.9.0" + } + }, + "mississippi": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/mississippi/-/mississippi-3.0.0.tgz", + "integrity": "sha512-x471SsVjUtBRtcvd4BzKE9kFC+/2TeWgKCgw0bZcw1b9l2X3QX5vCWgF+KaZaYm87Ss//rHnWryupDrgLvmSkA==", + "requires": { + "concat-stream": "^1.5.0", + "duplexify": "^3.4.2", + "end-of-stream": "^1.1.0", + "flush-write-stream": "^1.0.0", + "from2": "^2.1.0", + "parallel-transform": "^1.1.0", + "pump": "^3.0.0", + "pumpify": "^1.3.3", + "stream-each": "^1.1.0", + "through2": "^2.0.0" + } + }, + "mixin-deep": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/mixin-deep/-/mixin-deep-1.3.2.tgz", + "integrity": "sha512-WRoDn//mXBiJ1H40rqa3vH0toePwSsGb45iInWlTySa+Uu4k3tYUSxa2v1KqAiLtvlrSzaExqS1gtk96A9zvEA==", + "requires": { + "for-in": "^1.0.2", + "is-extendable": "^1.0.1" + }, + "dependencies": { + "is-extendable": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/is-extendable/-/is-extendable-1.0.1.tgz", + "integrity": "sha512-arnXMxT1hhoKo9k1LZdmlNyJdDDfy2v0fXjFlmok4+i8ul/6WlbVge9bhM74OpNPQPMGUToDtz+KXa1PneJxOA==", + "requires": { + "is-plain-object": "^2.0.4" + } + } + } + }, + "mkdirp": { + "version": "0.5.5", + "resolved": "https://registry.npmjs.org/mkdirp/-/mkdirp-0.5.5.tgz", + "integrity": "sha512-NKmAlESf6jMGym1++R0Ra7wvhV+wFW63FaSOFPwRahvea0gMUcGUhVeAg/0BC0wiv9ih5NYPB1Wn1UEI1/L+xQ==", + "requires": { + "minimist": "^1.2.5" + } + }, + "move-concurrently": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/move-concurrently/-/move-concurrently-1.0.1.tgz", + "integrity": "sha1-viwAX9oy4LKa8fBdfEszIUxwH5I=", + "requires": { + "aproba": "^1.1.1", + "copy-concurrently": "^1.0.0", + "fs-write-stream-atomic": "^1.0.8", + "mkdirp": "^0.5.1", + "rimraf": "^2.5.4", + "run-queue": "^1.0.3" + } + }, + "ms": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.1.2.tgz", + "integrity": "sha512-sGkPx+VjMtmA6MX27oA4FBFELFCZZ4S4XqeGOXCv68tT+jb3vk/RyaKWP0PTKyWtmLSM0b+adUTEvbs1PEaH2w==" + }, + "multicast-dns": { + "version": "6.2.3", + "resolved": "https://registry.npmjs.org/multicast-dns/-/multicast-dns-6.2.3.tgz", + "integrity": "sha512-ji6J5enbMyGRHIAkAOu3WdV8nggqviKCEKtXcOqfphZZtQrmHKycfynJ2V7eVPUA4NhJ6V7Wf4TmGbTwKE9B6g==", + "requires": { + "dns-packet": "^1.3.1", + "thunky": "^1.0.2" + } + }, + "multicast-dns-service-types": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/multicast-dns-service-types/-/multicast-dns-service-types-1.1.0.tgz", + "integrity": "sha1-iZ8R2WhuXgXLkbNdXw5jt3PPyQE=" + }, + "nan": { + "version": "2.14.2", + "resolved": "https://registry.npmjs.org/nan/-/nan-2.14.2.tgz", + "integrity": "sha512-M2ufzIiINKCuDfBSAUr1vWQ+vuVcA9kqx8JJUsbQi6yf1uGRyb7HfpdfUr5qLXf3B/t8dPvcjhKMmlfnP47EzQ==", + "optional": true + }, + "nanomatch": { + "version": "1.2.13", + "resolved": "https://registry.npmjs.org/nanomatch/-/nanomatch-1.2.13.tgz", + "integrity": "sha512-fpoe2T0RbHwBTBUOftAfBPaDEi06ufaUai0mE6Yn1kacc3SnTErfb/h+X94VXzI64rKFHYImXSvdwGGCmwOqCA==", + "requires": { + "arr-diff": "^4.0.0", + "array-unique": "^0.3.2", + "define-property": "^2.0.2", + "extend-shallow": "^3.0.2", + "fragment-cache": "^0.2.1", + "is-windows": "^1.0.2", + "kind-of": "^6.0.2", + "object.pick": "^1.3.0", + "regex-not": "^1.0.0", + "snapdragon": "^0.8.1", + "to-regex": "^3.0.1" + } + }, + "negotiator": { + "version": "0.6.2", + "resolved": "https://registry.npmjs.org/negotiator/-/negotiator-0.6.2.tgz", + "integrity": "sha512-hZXc7K2e+PgeI1eDBe/10Ard4ekbfrrqG8Ep+8Jmf4JID2bNg7NvCPOZN+kfF574pFQI7mum2AUqDidoKqcTOw==" + }, + "neo-async": { + "version": "2.6.2", + "resolved": "https://registry.npmjs.org/neo-async/-/neo-async-2.6.2.tgz", + "integrity": "sha512-Yd3UES5mWCSqR+qNT93S3UoYUkqAZ9lLg8a7g9rimsWmYGK8cVToA4/sF3RrshdyV3sAGMXVUmpMYOw+dLpOuw==" + }, + "nice-try": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/nice-try/-/nice-try-1.0.5.tgz", + "integrity": "sha512-1nh45deeb5olNY7eX82BkPO7SSxR5SSYJiPTrTdFUVYwAl8CKMA5N9PjTYkHiRjisVcxcQ1HXdLhx2qxxJzLNQ==" + }, + "no-case": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/no-case/-/no-case-3.0.4.tgz", + "integrity": "sha512-fgAN3jGAh+RoxUGZHTSOLJIqUc2wmoBwGR4tbpNAKmmovFoWq0OdRkb0VkldReO2a2iBT/OEulG9XSUc10r3zg==", + "requires": { + "lower-case": "^2.0.2", + "tslib": "^2.0.3" + } + }, + "node-addon-api": { + "version": "1.7.2", + "resolved": "https://registry.npmjs.org/node-addon-api/-/node-addon-api-1.7.2.tgz", + "integrity": "sha512-ibPK3iA+vaY1eEjESkQkM0BbCqFOaZMiXRTtdB0u7b4djtY6JnsjvPdUHVMg6xQt3B8fpTTWHI9A+ADjM9frzg==" + }, + "node-forge": { + "version": "0.7.6", + "resolved": "https://registry.npmjs.org/node-forge/-/node-forge-0.7.6.tgz", + "integrity": "sha512-sol30LUpz1jQFBjOKwbjxijiE3b6pjd74YwfD0fJOKPjF+fONKb2Yg8rYgS6+bK6VDl+/wfr4IYpC7jDzLUIfw==" + }, + "node-libs-browser": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/node-libs-browser/-/node-libs-browser-2.2.1.tgz", + "integrity": "sha512-h/zcD8H9kaDZ9ALUWwlBUDo6TKF8a7qBSCSEGfjTVIYeqsioSKaAX+BN7NgiMGp6iSIXZ3PxgCu8KS3b71YK5Q==", + "requires": { + "assert": "^1.1.1", + "browserify-zlib": "^0.2.0", + "buffer": "^4.3.0", + "console-browserify": "^1.1.0", + "constants-browserify": "^1.0.0", + "crypto-browserify": "^3.11.0", + "domain-browser": "^1.1.1", + "events": "^3.0.0", + "https-browserify": "^1.0.0", + "os-browserify": "^0.3.0", + "path-browserify": "0.0.1", + "process": "^0.11.10", + "punycode": "^1.2.4", + "querystring-es3": "^0.2.0", + "readable-stream": "^2.3.3", + "stream-browserify": "^2.0.1", + "stream-http": "^2.7.2", + "string_decoder": "^1.0.0", + "timers-browserify": "^2.0.4", + "tty-browserify": "0.0.0", + "url": "^0.11.0", + "util": "^0.11.0", + "vm-browserify": "^1.0.1" + }, + "dependencies": { + "punycode": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-1.4.1.tgz", + "integrity": "sha1-wNWmOycYgArY4esPpSachN1BhF4=" + } + } + }, + "node-releases": { + "version": "1.1.73", + "resolved": "https://registry.npmjs.org/node-releases/-/node-releases-1.1.73.tgz", + "integrity": "sha512-uW7fodD6pyW2FZNZnp/Z3hvWKeEW1Y8R1+1CnErE8cXFXzl5blBOoVB41CvMer6P6Q0S5FXDwcHgFd1Wj0U9zg==" + }, + "nopt": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/nopt/-/nopt-5.0.0.tgz", + "integrity": "sha512-Tbj67rffqceeLpcRXrT7vKAN8CwfPeIBgM7E6iBkmKLV7bEMwpGgYLGv0jACUsECaa/vuxP0IjEont6umdMgtQ==", + "requires": { + "abbrev": "1" + } + }, + "normalize-path": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/normalize-path/-/normalize-path-3.0.0.tgz", + "integrity": "sha512-6eZs5Ls3WtCisHWp9S2GUy8dqkpGi4BVSz3GaqiE6ezub0512ESztXUwUB6C6IKbQkY2Pnb/mD4WYojCRwcwLA==" + }, + "normalize-url": { + "version": "3.3.0", + "resolved": "https://registry.npmjs.org/normalize-url/-/normalize-url-3.3.0.tgz", + "integrity": "sha512-U+JJi7duF1o+u2pynbp2zXDW2/PADgC30f0GsHZtRh+HOcXHnw137TrNlyxxRvWW5fjKd3bcLHPxofWuCjaeZg==" + }, + "npm-run-path": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/npm-run-path/-/npm-run-path-3.1.0.tgz", + "integrity": "sha512-Dbl4A/VfiVGLgQv29URL9xshU8XDY1GeLy+fsaZ1AA8JDSfjvr5P5+pzRbWqRSBxk6/DW7MIh8lTM/PaGnP2kg==", + "requires": { + "path-key": "^3.0.0" + }, + "dependencies": { + "path-key": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/path-key/-/path-key-3.1.1.tgz", + "integrity": "sha512-ojmeN0qd+y0jszEtoY48r0Peq5dwMEkIlCOu6Q5f41lfkswXuKtYrhgoTpLnyIcHm24Uhqx+5Tqm2InSwLhE6Q==" + } + } + }, + "nth-check": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/nth-check/-/nth-check-1.0.2.tgz", + "integrity": "sha512-WeBOdju8SnzPN5vTUJYxYUxLeXpCaVP5i5e0LF8fg7WORF2Wd7wFX/pk0tYZk7s8T+J7VLy0Da6J1+wCT0AtHg==", + "requires": { + "boolbase": "~1.0.0" + } + }, + "nwsapi": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/nwsapi/-/nwsapi-2.2.0.tgz", + "integrity": "sha512-h2AatdwYH+JHiZpv7pt/gSX1XoRGb7L/qSIeuqA6GwYoF9w1vP1cw42TO0aI2pNyshRK5893hNSl+1//vHK7hQ==" + }, + "oauth-sign": { + "version": "0.9.0", + "resolved": "https://registry.npmjs.org/oauth-sign/-/oauth-sign-0.9.0.tgz", + "integrity": "sha512-fexhUFFPTGV8ybAtSIGbV6gOkSv8UtRbDBnAyLQw4QPKkgNlsH2ByPGtMUqdWkos6YCRmAqViwgZrJc/mRDzZQ==" + }, + "object-assign": { + "version": "4.1.1", + "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-4.1.1.tgz", + "integrity": "sha1-IQmtx5ZYh8/AXLvUQsrIv7s2CGM=" + }, + "object-copy": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/object-copy/-/object-copy-0.1.0.tgz", + "integrity": "sha1-fn2Fi3gb18mRpBupde04EnVOmYw=", + "requires": { + "copy-descriptor": "^0.1.0", + "define-property": "^0.2.5", + "kind-of": "^3.0.3" + }, + "dependencies": { + "define-property": { + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-0.2.5.tgz", + "integrity": "sha1-w1se+RjsPJkPmlvFe+BKrOxcgRY=", + "requires": { + "is-descriptor": "^0.1.0" + } + }, + "kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "object-inspect": { + "version": "1.4.1", + "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.4.1.tgz", + "integrity": "sha512-wqdhLpfCUbEsoEwl3FXwGyv8ief1k/1aUdIPCqVnupM6e8l63BEJdiF/0swtn04/8p05tG/T0FrpTlfwvljOdw==" + }, + "object-is": { + "version": "1.1.5", + "resolved": "https://registry.npmjs.org/object-is/-/object-is-1.1.5.tgz", + "integrity": "sha512-3cyDsyHgtmi7I7DfSSI2LDp6SK2lwvtbg0p0R1e0RvTqF5ceGx+K2dfSjm1bKDMVCFEDAQvy+o8c6a7VujOddw==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3" + } + }, + "object-keys": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/object-keys/-/object-keys-1.1.1.tgz", + "integrity": "sha512-NuAESUOUMrlIXOfHKzD6bpPu3tYt3xvjNdRIQ+FeT0lNb4K8WR70CaDxhuNguS2XG+GjkyMwOzsN5ZktImfhLA==" + }, + "object-visit": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/object-visit/-/object-visit-1.0.1.tgz", + "integrity": "sha1-95xEk68MU3e1n+OdOV5BBC3QRbs=", + "requires": { + "isobject": "^3.0.0" + } + }, + "object.assign": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/object.assign/-/object.assign-4.1.2.tgz", + "integrity": "sha512-ixT2L5THXsApyiUPYKmW+2EHpXXe5Ii3M+f4e+aJFAHao5amFRW6J0OO6c/LU8Be47utCx2GL89hxGB6XSmKuQ==", + "requires": { + "call-bind": "^1.0.0", + "define-properties": "^1.1.3", + "has-symbols": "^1.0.1", + "object-keys": "^1.1.1" + } + }, + "object.getownpropertydescriptors": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/object.getownpropertydescriptors/-/object.getownpropertydescriptors-2.1.2.tgz", + "integrity": "sha512-WtxeKSzfBjlzL+F9b7M7hewDzMwy+C8NRssHd1YrNlzHzIDrXcXiNOMrezdAEM4UXixgV+vvnyBeN7Rygl2ttQ==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3", + "es-abstract": "^1.18.0-next.2" + } + }, + "object.pick": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/object.pick/-/object.pick-1.3.0.tgz", + "integrity": "sha1-h6EKxMFpS9Lhy/U1kaZhQftd10c=", + "requires": { + "isobject": "^3.0.1" + } + }, + "object.values": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/object.values/-/object.values-1.1.4.tgz", + "integrity": "sha512-TnGo7j4XSnKQoK3MfvkzqKCi0nVe/D9I9IjwTNYdb/fxYHpjrluHVOgw0AF6jrRFGMPHdfuidR09tIDiIvnaSg==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3", + "es-abstract": "^1.18.2" + } + }, + "obuf": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/obuf/-/obuf-1.1.2.tgz", + "integrity": "sha512-PX1wu0AmAdPqOL1mWhqmlOd8kOIZQwGZw6rh7uby9fTc5lhaOWFLX3I6R1hrF9k3zUY40e6igsLGkDXK92LJNg==" + }, + "on-finished": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/on-finished/-/on-finished-2.3.0.tgz", + "integrity": "sha1-IPEzZIGwg811M3mSoWlxqi2QaUc=", + "requires": { + "ee-first": "1.1.1" + } + }, + "on-headers": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/on-headers/-/on-headers-1.0.2.tgz", + "integrity": "sha512-pZAE+FJLoyITytdqK0U5s+FIpjN0JP3OzFi/u8Rx+EV5/W+JTWGXG8xFzevE7AjBfDqHv/8vL8qQsIhHnqRkrA==" + }, + "once": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/once/-/once-1.4.0.tgz", + "integrity": "sha1-WDsap3WWHUsROsF9nFC6753Xa9E=", + "requires": { + "wrappy": "1" + } + }, + "onetime": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/onetime/-/onetime-2.0.1.tgz", + "integrity": "sha1-BnQoIw/WdEOyeUsiu6UotoZ5YtQ=", + "requires": { + "mimic-fn": "^1.0.0" + } + }, + "opn": { + "version": "5.5.0", + "resolved": "https://registry.npmjs.org/opn/-/opn-5.5.0.tgz", + "integrity": "sha512-PqHpggC9bLV0VeWcdKhkpxY+3JTzetLSqTCWL/z/tFIbI6G8JCjondXklT1JinczLz2Xib62sSp0T/gKT4KksA==", + "requires": { + "is-wsl": "^1.1.0" + } + }, + "optionator": { + "version": "0.8.3", + "resolved": "https://registry.npmjs.org/optionator/-/optionator-0.8.3.tgz", + "integrity": "sha512-+IW9pACdk3XWmmTXG8m3upGUJst5XRGzxMRjXzAuJ1XnIFNvfhjjIuYkDvysnPQ7qzqVzLt78BCruntqRhWQbA==", + "requires": { + "deep-is": "~0.1.3", + "fast-levenshtein": "~2.0.6", + "levn": "~0.3.0", + "prelude-ls": "~1.1.2", + "type-check": "~0.3.2", + "word-wrap": "~1.2.3" + } + }, + "ora": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/ora/-/ora-2.1.0.tgz", + "integrity": "sha512-hNNlAd3gfv/iPmsNxYoAPLvxg7HuPozww7fFonMZvL84tP6Ox5igfk5j/+a9rtJJwqMgKK+JgWsAQik5o0HTLA==", + "requires": { + "chalk": "^2.3.1", + "cli-cursor": "^2.1.0", + "cli-spinners": "^1.1.0", + "log-symbols": "^2.2.0", + "strip-ansi": "^4.0.0", + "wcwidth": "^1.0.1" + } + }, + "original": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/original/-/original-1.0.2.tgz", + "integrity": "sha512-hyBVl6iqqUOJ8FqRe+l/gS8H+kKYjrEndd5Pm1MfBtsEKA038HkkdbAl/72EAXGyonD/PFsvmVG+EvcIpliMBg==", + "requires": { + "url-parse": "^1.4.3" + } + }, + "os-browserify": { + "version": "0.3.0", + "resolved": "https://registry.npmjs.org/os-browserify/-/os-browserify-0.3.0.tgz", + "integrity": "sha1-hUNzx/XCMVkU/Jv8a9gjj92h7Cc=" + }, + "p-finally": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/p-finally/-/p-finally-2.0.1.tgz", + "integrity": "sha512-vpm09aKwq6H9phqRQzecoDpD8TmVyGw70qmWlyq5onxY7tqyTTFVvxMykxQSQKILBSFlbXpypIw2T1Ml7+DDtw==" + }, + "p-limit": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/p-limit/-/p-limit-3.1.0.tgz", + "integrity": "sha512-TYOanM3wGwNGsZN2cVTYPArw454xnXj5qmWF1bEoAc4+cU/ol7GVh7odevjp1FNHduHc3KZMcFduxU5Xc6uJRQ==", + "requires": { + "yocto-queue": "^0.1.0" + } + }, + "p-locate": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-4.1.0.tgz", + "integrity": "sha512-R79ZZ/0wAxKGu3oYMlz8jy/kbhsNrS7SKZ7PxEHBgJ5+F2mtFW2fK2cOtBh1cHYkQsbzFV7I+EoRKe6Yt0oK7A==", + "requires": { + "p-limit": "^2.2.0" + }, + "dependencies": { + "p-limit": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/p-limit/-/p-limit-2.3.0.tgz", + "integrity": "sha512-//88mFWSJx8lxCzwdAABTJL2MyWB12+eIY7MDL2SqLmAkeKU9qxRvWuSyTjm3FUmpBEMuFfckAIqEaVGUDxb6w==", + "requires": { + "p-try": "^2.0.0" + } + } + } + }, + "p-map": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/p-map/-/p-map-2.1.0.tgz", + "integrity": "sha512-y3b8Kpd8OAN444hxfBbFfj1FY/RjtTd8tzYwhUqNYXx0fXx2iX4maP4Qr6qhIKbQXI02wTLAda4fYUbDagTUFw==" + }, + "p-retry": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/p-retry/-/p-retry-3.0.1.tgz", + "integrity": "sha512-XE6G4+YTTkT2a0UWb2kjZe8xNwf8bIbnqpc/IS/idOBVhyves0mK5OJgeocjx7q5pvX/6m23xuzVPYT1uGM73w==", + "requires": { + "retry": "^0.12.0" + } + }, + "p-try": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/p-try/-/p-try-2.2.0.tgz", + "integrity": "sha512-R4nPAVTAU0B9D35/Gk3uJf/7XYbQcyohSKdvAxIRSNghFl4e71hVoGnBNQz9cWaXxO2I10KTC+3jMdvvoKw6dQ==" + }, + "pako": { + "version": "0.2.9", + "resolved": "https://registry.npmjs.org/pako/-/pako-0.2.9.tgz", + "integrity": "sha1-8/dSL073gjSNqBYbrZ7P1Rv4OnU=" + }, + "parallel-transform": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/parallel-transform/-/parallel-transform-1.2.0.tgz", + "integrity": "sha512-P2vSmIu38uIlvdcU7fDkyrxj33gTUy/ABO5ZUbGowxNCopBq/OoD42bP4UmMrJoPyk4Uqf0mu3mtWBhHCZD8yg==", + "requires": { + "cyclist": "^1.0.1", + "inherits": "^2.0.3", + "readable-stream": "^2.1.5" + } + }, + "param-case": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/param-case/-/param-case-3.0.4.tgz", + "integrity": "sha512-RXlj7zCYokReqWpOPH9oYivUzLYZ5vAPIfEmCTNViosC78F8F0H9y7T7gG2M39ymgutxF5gcFEsyZQSph9Bp3A==", + "requires": { + "dot-case": "^3.0.4", + "tslib": "^2.0.3" + } + }, + "parcel": { + "version": "1.12.3", + "resolved": "https://registry.npmjs.org/parcel/-/parcel-1.12.3.tgz", + "integrity": "sha512-j9XCVLeol9qZvGemRKt2z8bptbXq9LVy8/IzjqWQKMiKd8DR0NpDAlRHV0zyF72/J/UUTsdsrhnw6UGo9nGI+Q==", + "requires": { + "@babel/code-frame": "^7.0.0 <7.4.0", + "@babel/core": "^7.0.0 <7.4.0", + "@babel/generator": "^7.0.0 <7.4.0", + "@babel/parser": "^7.0.0 <7.4.0", + "@babel/plugin-transform-flow-strip-types": "^7.0.0 <7.4.0", + "@babel/plugin-transform-modules-commonjs": "^7.0.0 <7.4.0", + "@babel/plugin-transform-react-jsx": "^7.0.0 <7.4.0", + "@babel/preset-env": "^7.0.0 <7.4.0", + "@babel/runtime": "^7.0.0 <7.4.0", + "@babel/template": "^7.0.0 <7.4.0", + "@babel/traverse": "^7.0.0 <7.4.0", + "@babel/types": "^7.0.0 <7.4.0", + "@iarna/toml": "^2.2.0", + "@parcel/fs": "^1.11.0", + "@parcel/logger": "^1.11.0", + "@parcel/utils": "^1.11.0", + "@parcel/watcher": "^1.12.0", + "@parcel/workers": "^1.11.0", + "ansi-to-html": "^0.6.4", + "babylon-walk": "^1.0.2", + "browserslist": "^4.1.0", + "chalk": "^2.1.0", + "clone": "^2.1.1", + "command-exists": "^1.2.6", + "commander": "^2.11.0", + "cross-spawn": "^6.0.4", + "css-modules-loader-core": "^1.1.0", + "cssnano": "^4.0.0", + "deasync": "^0.1.14", + "dotenv": "^5.0.0", + "dotenv-expand": "^4.2.0", + "fast-glob": "^2.2.2", + "filesize": "^3.6.0", + "get-port": "^3.2.0", + "htmlnano": "^0.2.2", + "is-glob": "^4.0.0", + "is-url": "^1.2.2", + "js-yaml": "^3.10.0", + "json5": "^1.0.1", + "micromatch": "^3.0.4", + "mkdirp": "^0.5.1", + "node-forge": "^0.7.1", + "node-libs-browser": "^2.0.0", + "opn": "^5.1.0", + "postcss": "^7.0.11", + "postcss-value-parser": "^3.3.1", + "posthtml": "^0.11.2", + "posthtml-parser": "^0.4.0", + "posthtml-render": "^1.1.3", + "resolve": "^1.4.0", + "semver": "^5.4.1", + "serialize-to-js": "^1.1.1", + "serve-static": "^1.12.4", + "source-map": "0.6.1", + "terser": "^3.7.3", + "v8-compile-cache": "^2.0.0", + "ws": "^5.1.1" + } + }, + "parse-asn1": { + "version": "5.1.6", + "resolved": "https://registry.npmjs.org/parse-asn1/-/parse-asn1-5.1.6.tgz", + "integrity": "sha512-RnZRo1EPU6JBnra2vGHj0yhp6ebyjBZpmUCLHWiFhxlzvBCCpAuZ7elsBp1PVAbQN0/04VD/19rfzlBSwLstMw==", + "requires": { + "asn1.js": "^5.2.0", + "browserify-aes": "^1.0.0", + "evp_bytestokey": "^1.0.0", + "pbkdf2": "^3.0.3", + "safe-buffer": "^5.1.1" + } + }, + "parse-json": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/parse-json/-/parse-json-4.0.0.tgz", + "integrity": "sha1-vjX1Qlvh9/bHRxhPmKeIy5lHfuA=", + "requires": { + "error-ex": "^1.3.1", + "json-parse-better-errors": "^1.0.1" + } + }, + "parse5": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/parse5/-/parse5-5.1.0.tgz", + "integrity": "sha512-fxNG2sQjHvlVAYmzBZS9YlDp6PTSSDwa98vkD4QgVDDCAo84z5X1t5XyJQ62ImdLXx5NdIIfihey6xpum9/gRQ==" + }, + "parseurl": { + "version": "1.3.3", + "resolved": "https://registry.npmjs.org/parseurl/-/parseurl-1.3.3.tgz", + "integrity": "sha512-CiyeOxFT/JZyN5m0z9PfXw4SCBJ6Sygz1Dpl0wqjlhDEGGBP1GnsUVEL0p63hoG1fcj3fHynXi9NYO4nWOL+qQ==" + }, + "pascal-case": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/pascal-case/-/pascal-case-3.1.2.tgz", + "integrity": "sha512-uWlGT3YSnK9x3BQJaOdcZwrnV6hPpd8jFH1/ucpiLRPh/2zCVJKS19E4GvYHvaCcACn3foXZ0cLB9Wrx1KGe5g==", + "requires": { + "no-case": "^3.0.4", + "tslib": "^2.0.3" + } + }, + "pascalcase": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/pascalcase/-/pascalcase-0.1.1.tgz", + "integrity": "sha1-s2PlXoAGym/iF4TS2yK9FdeRfxQ=" + }, + "path-browserify": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/path-browserify/-/path-browserify-0.0.1.tgz", + "integrity": "sha512-BapA40NHICOS+USX9SN4tyhq+A2RrN/Ws5F0Z5aMHDp98Fl86lX8Oti8B7uN93L4Ifv4fHOEA+pQw87gmMO/lQ==" + }, + "path-dirname": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/path-dirname/-/path-dirname-1.0.2.tgz", + "integrity": "sha1-zDPSTVJeCZpTiMAzbG4yuRYGCeA=" + }, + "path-exists": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-4.0.0.tgz", + "integrity": "sha512-ak9Qy5Q7jYb2Wwcey5Fpvg2KoAc/ZIhLSLOSBmRmygPsGwkVVt0fZa0qrtMz+m6tJTAHfZQ8FnmB4MG4LWy7/w==" + }, + "path-is-absolute": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/path-is-absolute/-/path-is-absolute-1.0.1.tgz", + "integrity": "sha1-F0uSaHNVNP+8es5r9TpanhtcX18=" + }, + "path-is-inside": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/path-is-inside/-/path-is-inside-1.0.2.tgz", + "integrity": "sha1-NlQX3t5EQw0cEa9hAn+s8HS9/FM=" + }, + "path-key": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/path-key/-/path-key-2.0.1.tgz", + "integrity": "sha1-QRyttXTFoUDTpLGRDUDYDMn0C0A=" + }, + "path-parse": { + "version": "1.0.7", + "resolved": "https://registry.npmjs.org/path-parse/-/path-parse-1.0.7.tgz", + "integrity": "sha512-LDJzPVEEEPR+y48z93A0Ed0yXb8pAByGWo/k5YYdYgpY2/2EsOsksJrq7lOHxryrVOn1ejG6oAp8ahvOIQD8sw==" + }, + "path-to-regexp": { + "version": "0.1.7", + "resolved": "https://registry.npmjs.org/path-to-regexp/-/path-to-regexp-0.1.7.tgz", + "integrity": "sha1-32BBeABfUi8V60SQ5yR6G/qmf4w=" + }, + "pbkdf2": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/pbkdf2/-/pbkdf2-3.1.2.tgz", + "integrity": "sha512-iuh7L6jA7JEGu2WxDwtQP1ddOpaJNC4KlDEFfdQajSGgGPNi4OyDc2R7QnbY2bR9QjBVGwgvTdNJZoE7RaxUMA==", + "requires": { + "create-hash": "^1.1.2", + "create-hmac": "^1.1.4", + "ripemd160": "^2.0.1", + "safe-buffer": "^5.0.1", + "sha.js": "^2.4.8" + } + }, + "performance-now": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/performance-now/-/performance-now-2.1.0.tgz", + "integrity": "sha1-Ywn04OX6kT7BxpMHrjZLSzd8nns=" + }, + "physical-cpu-count": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/physical-cpu-count/-/physical-cpu-count-2.0.0.tgz", + "integrity": "sha1-GN4vl+S/epVRrXURlCtUlverpmA=" + }, + "pify": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/pify/-/pify-4.0.1.tgz", + "integrity": "sha512-uB80kBFb/tfd68bVleG9T5GGsGPjJrLAUpR5PZIrhBnIaRTQRjqdJSsIKkOP6OAIFbj7GOrcudc5pNjZ+geV2g==" + }, + "pinkie": { + "version": "2.0.4", + "resolved": "https://registry.npmjs.org/pinkie/-/pinkie-2.0.4.tgz", + "integrity": "sha1-clVrgM+g1IqXToDnckjoDtT3+HA=" + }, + "pinkie-promise": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/pinkie-promise/-/pinkie-promise-2.0.1.tgz", + "integrity": "sha1-ITXW36ejWMBprJsXh3YogihFD/o=", + "requires": { + "pinkie": "^2.0.0" + } + }, + "pkg-dir": { + "version": "4.2.0", + "resolved": "https://registry.npmjs.org/pkg-dir/-/pkg-dir-4.2.0.tgz", + "integrity": "sha512-HRDzbaKjC+AOWVXxAU/x54COGeIv9eb+6CkDSQoNTt4XyWoIJvuPsXizxu/Fr23EiekbtZwmh1IcIG/l/a10GQ==", + "requires": { + "find-up": "^4.0.0" + } + }, + "pn": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/pn/-/pn-1.1.0.tgz", + "integrity": "sha512-2qHaIQr2VLRFoxe2nASzsV6ef4yOOH+Fi9FBOVH6cqeSgUnoyySPZkxzLuzd+RYOQTRpROA0ztTMqxROKSb/nA==" + }, + "portfinder": { + "version": "1.0.28", + "resolved": "https://registry.npmjs.org/portfinder/-/portfinder-1.0.28.tgz", + "integrity": "sha512-Se+2isanIcEqf2XMHjyUKskczxbPH7dQnlMjXX6+dybayyHvAf/TCgyMRlzf/B6QDhAEFOGes0pzRo3by4AbMA==", + "requires": { + "async": "^2.6.2", + "debug": "^3.1.1", + "mkdirp": "^0.5.5" + }, + "dependencies": { + "debug": { + "version": "3.2.7", + "resolved": "https://registry.npmjs.org/debug/-/debug-3.2.7.tgz", + "integrity": "sha512-CFjzYYAi4ThfiQvizrFQevTTXHtnCqWfe7x1AhgEscTz6ZbLbfoLRLPugTQyBth6f8ZERVUSyWHFD/7Wu4t1XQ==", + "requires": { + "ms": "^2.1.1" + } + } + } + }, + "posix-character-classes": { + "version": "0.1.1", + "resolved": "https://registry.npmjs.org/posix-character-classes/-/posix-character-classes-0.1.1.tgz", + "integrity": "sha1-AerA/jta9xoqbAL+q7jB/vfgDqs=" + }, + "postcss": { + "version": "7.0.36", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-7.0.36.tgz", + "integrity": "sha512-BebJSIUMwJHRH0HAQoxN4u1CN86glsrwsW0q7T+/m44eXOUAxSNdHRkNZPYz5vVUbg17hFgOQDE7fZk7li3pZw==", + "requires": { + "chalk": "^2.4.2", + "source-map": "^0.6.1", + "supports-color": "^6.1.0" + }, + "dependencies": { + "supports-color": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-6.1.0.tgz", + "integrity": "sha512-qe1jfm1Mg7Nq/NSh6XE24gPXROEVsWHxC1LIx//XNlD9iw7YZQGjZNjYN7xGaEG6iKdA8EtNFW6R0gjnVXp+wQ==", + "requires": { + "has-flag": "^3.0.0" + } + } + } + }, + "postcss-calc": { + "version": "7.0.5", + "resolved": "https://registry.npmjs.org/postcss-calc/-/postcss-calc-7.0.5.tgz", + "integrity": "sha512-1tKHutbGtLtEZF6PT4JSihCHfIVldU72mZ8SdZHIYriIZ9fh9k9aWSppaT8rHsyI3dX+KSR+W+Ix9BMY3AODrg==", + "requires": { + "postcss": "^7.0.27", + "postcss-selector-parser": "^6.0.2", + "postcss-value-parser": "^4.0.2" + }, + "dependencies": { + "postcss-value-parser": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/postcss-value-parser/-/postcss-value-parser-4.1.0.tgz", + "integrity": "sha512-97DXOFbQJhk71ne5/Mt6cOu6yxsSfM0QGQyl0L25Gca4yGWEGJaig7l7gbCX623VqTBNGLRLaVUCnNkcedlRSQ==" + } + } + }, + "postcss-colormin": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/postcss-colormin/-/postcss-colormin-4.0.3.tgz", + "integrity": "sha512-WyQFAdDZpExQh32j0U0feWisZ0dmOtPl44qYmJKkq9xFWY3p+4qnRzCHeNrkeRhwPHz9bQ3mo0/yVkaply0MNw==", + "requires": { + "browserslist": "^4.0.0", + "color": "^3.0.0", + "has": "^1.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-convert-values": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-convert-values/-/postcss-convert-values-4.0.1.tgz", + "integrity": "sha512-Kisdo1y77KUC0Jmn0OXU/COOJbzM8cImvw1ZFsBgBgMgb1iL23Zs/LXRe3r+EZqM3vGYKdQ2YJVQ5VkJI+zEJQ==", + "requires": { + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-discard-comments": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-discard-comments/-/postcss-discard-comments-4.0.2.tgz", + "integrity": "sha512-RJutN259iuRf3IW7GZyLM5Sw4GLTOH8FmsXBnv8Ab/Tc2k4SR4qbV4DNbyyY4+Sjo362SyDmW2DQ7lBSChrpkg==", + "requires": { + "postcss": "^7.0.0" + } + }, + "postcss-discard-duplicates": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-discard-duplicates/-/postcss-discard-duplicates-4.0.2.tgz", + "integrity": "sha512-ZNQfR1gPNAiXZhgENFfEglF93pciw0WxMkJeVmw8eF+JZBbMD7jp6C67GqJAXVZP2BWbOztKfbsdmMp/k8c6oQ==", + "requires": { + "postcss": "^7.0.0" + } + }, + "postcss-discard-empty": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-discard-empty/-/postcss-discard-empty-4.0.1.tgz", + "integrity": "sha512-B9miTzbznhDjTfjvipfHoqbWKwd0Mj+/fL5s1QOz06wufguil+Xheo4XpOnc4NqKYBCNqqEzgPv2aPBIJLox0w==", + "requires": { + "postcss": "^7.0.0" + } + }, + "postcss-discard-overridden": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-discard-overridden/-/postcss-discard-overridden-4.0.1.tgz", + "integrity": "sha512-IYY2bEDD7g1XM1IDEsUT4//iEYCxAmP5oDSFMVU/JVvT7gh+l4fmjciLqGgwjdWpQIdb0Che2VX00QObS5+cTg==", + "requires": { + "postcss": "^7.0.0" + } + }, + "postcss-merge-longhand": { + "version": "4.0.11", + "resolved": "https://registry.npmjs.org/postcss-merge-longhand/-/postcss-merge-longhand-4.0.11.tgz", + "integrity": "sha512-alx/zmoeXvJjp7L4mxEMjh8lxVlDFX1gqWHzaaQewwMZiVhLo42TEClKaeHbRf6J7j82ZOdTJ808RtN0ZOZwvw==", + "requires": { + "css-color-names": "0.0.4", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0", + "stylehacks": "^4.0.0" + } + }, + "postcss-merge-rules": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/postcss-merge-rules/-/postcss-merge-rules-4.0.3.tgz", + "integrity": "sha512-U7e3r1SbvYzO0Jr3UT/zKBVgYYyhAz0aitvGIYOYK5CPmkNih+WDSsS5tvPrJ8YMQYlEMvsZIiqmn7HdFUaeEQ==", + "requires": { + "browserslist": "^4.0.0", + "caniuse-api": "^3.0.0", + "cssnano-util-same-parent": "^4.0.0", + "postcss": "^7.0.0", + "postcss-selector-parser": "^3.0.0", + "vendors": "^1.0.0" + }, + "dependencies": { + "postcss-selector-parser": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-3.1.2.tgz", + "integrity": "sha512-h7fJ/5uWuRVyOtkO45pnt1Ih40CEleeyCHzipqAZO2e5H20g25Y48uYnFUiShvY4rZWNJ/Bib/KVPmanaCtOhA==", + "requires": { + "dot-prop": "^5.2.0", + "indexes-of": "^1.0.1", + "uniq": "^1.0.1" + } + } + } + }, + "postcss-minify-font-values": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-minify-font-values/-/postcss-minify-font-values-4.0.2.tgz", + "integrity": "sha512-j85oO6OnRU9zPf04+PZv1LYIYOprWm6IA6zkXkrJXyRveDEuQggG6tvoy8ir8ZwjLxLuGfNkCZEQG7zan+Hbtg==", + "requires": { + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-minify-gradients": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-minify-gradients/-/postcss-minify-gradients-4.0.2.tgz", + "integrity": "sha512-qKPfwlONdcf/AndP1U8SJ/uzIJtowHlMaSioKzebAXSG4iJthlWC9iSWznQcX4f66gIWX44RSA841HTHj3wK+Q==", + "requires": { + "cssnano-util-get-arguments": "^4.0.0", + "is-color-stop": "^1.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-minify-params": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-minify-params/-/postcss-minify-params-4.0.2.tgz", + "integrity": "sha512-G7eWyzEx0xL4/wiBBJxJOz48zAKV2WG3iZOqVhPet/9geefm/Px5uo1fzlHu+DOjT+m0Mmiz3jkQzVHe6wxAWg==", + "requires": { + "alphanum-sort": "^1.0.0", + "browserslist": "^4.0.0", + "cssnano-util-get-arguments": "^4.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0", + "uniqs": "^2.0.0" + } + }, + "postcss-minify-selectors": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-minify-selectors/-/postcss-minify-selectors-4.0.2.tgz", + "integrity": "sha512-D5S1iViljXBj9kflQo4YutWnJmwm8VvIsU1GeXJGiG9j8CIg9zs4voPMdQDUmIxetUOh60VilsNzCiAFTOqu3g==", + "requires": { + "alphanum-sort": "^1.0.0", + "has": "^1.0.0", + "postcss": "^7.0.0", + "postcss-selector-parser": "^3.0.0" + }, + "dependencies": { + "postcss-selector-parser": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-3.1.2.tgz", + "integrity": "sha512-h7fJ/5uWuRVyOtkO45pnt1Ih40CEleeyCHzipqAZO2e5H20g25Y48uYnFUiShvY4rZWNJ/Bib/KVPmanaCtOhA==", + "requires": { + "dot-prop": "^5.2.0", + "indexes-of": "^1.0.1", + "uniq": "^1.0.1" + } + } + } + }, + "postcss-modules-extract-imports": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/postcss-modules-extract-imports/-/postcss-modules-extract-imports-1.1.0.tgz", + "integrity": "sha1-thTJcgvmgW6u41+zpfqh26agXds=", + "requires": { + "postcss": "^6.0.1" + }, + "dependencies": { + "postcss": { + "version": "6.0.23", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-6.0.23.tgz", + "integrity": "sha512-soOk1h6J3VMTZtVeVpv15/Hpdl2cBLX3CAw4TAbkpTJiNPk9YP/zWcD1ND+xEtvyuuvKzbxliTOIyvkSeSJ6ag==", + "requires": { + "chalk": "^2.4.1", + "source-map": "^0.6.1", + "supports-color": "^5.4.0" + } + } + } + }, + "postcss-modules-local-by-default": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/postcss-modules-local-by-default/-/postcss-modules-local-by-default-1.2.0.tgz", + "integrity": "sha1-99gMOYxaOT+nlkRmvRlQCn1hwGk=", + "requires": { + "css-selector-tokenizer": "^0.7.0", + "postcss": "^6.0.1" + }, + "dependencies": { + "postcss": { + "version": "6.0.23", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-6.0.23.tgz", + "integrity": "sha512-soOk1h6J3VMTZtVeVpv15/Hpdl2cBLX3CAw4TAbkpTJiNPk9YP/zWcD1ND+xEtvyuuvKzbxliTOIyvkSeSJ6ag==", + "requires": { + "chalk": "^2.4.1", + "source-map": "^0.6.1", + "supports-color": "^5.4.0" + } + } + } + }, + "postcss-modules-scope": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/postcss-modules-scope/-/postcss-modules-scope-1.1.0.tgz", + "integrity": "sha1-1upkmUx5+XtipytCb75gVqGUu5A=", + "requires": { + "css-selector-tokenizer": "^0.7.0", + "postcss": "^6.0.1" + }, + "dependencies": { + "postcss": { + "version": "6.0.23", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-6.0.23.tgz", + "integrity": "sha512-soOk1h6J3VMTZtVeVpv15/Hpdl2cBLX3CAw4TAbkpTJiNPk9YP/zWcD1ND+xEtvyuuvKzbxliTOIyvkSeSJ6ag==", + "requires": { + "chalk": "^2.4.1", + "source-map": "^0.6.1", + "supports-color": "^5.4.0" + } + } + } + }, + "postcss-modules-values": { + "version": "1.3.0", + "resolved": "https://registry.npmjs.org/postcss-modules-values/-/postcss-modules-values-1.3.0.tgz", + "integrity": "sha1-7P+p1+GSUYOJ9CrQ6D9yrsRW6iA=", + "requires": { + "icss-replace-symbols": "^1.1.0", + "postcss": "^6.0.1" + }, + "dependencies": { + "postcss": { + "version": "6.0.23", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-6.0.23.tgz", + "integrity": "sha512-soOk1h6J3VMTZtVeVpv15/Hpdl2cBLX3CAw4TAbkpTJiNPk9YP/zWcD1ND+xEtvyuuvKzbxliTOIyvkSeSJ6ag==", + "requires": { + "chalk": "^2.4.1", + "source-map": "^0.6.1", + "supports-color": "^5.4.0" + } + } + } + }, + "postcss-normalize-charset": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-charset/-/postcss-normalize-charset-4.0.1.tgz", + "integrity": "sha512-gMXCrrlWh6G27U0hF3vNvR3w8I1s2wOBILvA87iNXaPvSNo5uZAMYsZG7XjCUf1eVxuPfyL4TJ7++SGZLc9A3g==", + "requires": { + "postcss": "^7.0.0" + } + }, + "postcss-normalize-display-values": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-normalize-display-values/-/postcss-normalize-display-values-4.0.2.tgz", + "integrity": "sha512-3F2jcsaMW7+VtRMAqf/3m4cPFhPD3EFRgNs18u+k3lTJJlVe7d0YPO+bnwqo2xg8YiRpDXJI2u8A0wqJxMsQuQ==", + "requires": { + "cssnano-util-get-match": "^4.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-positions": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-normalize-positions/-/postcss-normalize-positions-4.0.2.tgz", + "integrity": "sha512-Dlf3/9AxpxE+NF1fJxYDeggi5WwV35MXGFnnoccP/9qDtFrTArZ0D0R+iKcg5WsUd8nUYMIl8yXDCtcrT8JrdA==", + "requires": { + "cssnano-util-get-arguments": "^4.0.0", + "has": "^1.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-repeat-style": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-normalize-repeat-style/-/postcss-normalize-repeat-style-4.0.2.tgz", + "integrity": "sha512-qvigdYYMpSuoFs3Is/f5nHdRLJN/ITA7huIoCyqqENJe9PvPmLhNLMu7QTjPdtnVf6OcYYO5SHonx4+fbJE1+Q==", + "requires": { + "cssnano-util-get-arguments": "^4.0.0", + "cssnano-util-get-match": "^4.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-string": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-normalize-string/-/postcss-normalize-string-4.0.2.tgz", + "integrity": "sha512-RrERod97Dnwqq49WNz8qo66ps0swYZDSb6rM57kN2J+aoyEAJfZ6bMx0sx/F9TIEX0xthPGCmeyiam/jXif0eA==", + "requires": { + "has": "^1.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-timing-functions": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-normalize-timing-functions/-/postcss-normalize-timing-functions-4.0.2.tgz", + "integrity": "sha512-acwJY95edP762e++00Ehq9L4sZCEcOPyaHwoaFOhIwWCDfik6YvqsYNxckee65JHLKzuNSSmAdxwD2Cud1Z54A==", + "requires": { + "cssnano-util-get-match": "^4.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-unicode": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-unicode/-/postcss-normalize-unicode-4.0.1.tgz", + "integrity": "sha512-od18Uq2wCYn+vZ/qCOeutvHjB5jm57ToxRaMeNuf0nWVHaP9Hua56QyMF6fs/4FSUnVIw0CBPsU0K4LnBPwYwg==", + "requires": { + "browserslist": "^4.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-url": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-normalize-url/-/postcss-normalize-url-4.0.1.tgz", + "integrity": "sha512-p5oVaF4+IHwu7VpMan/SSpmpYxcJMtkGppYf0VbdH5B6hN8YNmVyJLuY9FmLQTzY3fag5ESUUHDqM+heid0UVA==", + "requires": { + "is-absolute-url": "^2.0.0", + "normalize-url": "^3.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-normalize-whitespace": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-normalize-whitespace/-/postcss-normalize-whitespace-4.0.2.tgz", + "integrity": "sha512-tO8QIgrsI3p95r8fyqKV+ufKlSHh9hMJqACqbv2XknufqEDhDvbguXGBBqxw9nsQoXWf0qOqppziKJKHMD4GtA==", + "requires": { + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-ordered-values": { + "version": "4.1.2", + "resolved": "https://registry.npmjs.org/postcss-ordered-values/-/postcss-ordered-values-4.1.2.tgz", + "integrity": "sha512-2fCObh5UanxvSxeXrtLtlwVThBvHn6MQcu4ksNT2tsaV2Fg76R2CV98W7wNSlX+5/pFwEyaDwKLLoEV7uRybAw==", + "requires": { + "cssnano-util-get-arguments": "^4.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-reduce-initial": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/postcss-reduce-initial/-/postcss-reduce-initial-4.0.3.tgz", + "integrity": "sha512-gKWmR5aUulSjbzOfD9AlJiHCGH6AEVLaM0AV+aSioxUDd16qXP1PCh8d1/BGVvpdWn8k/HiK7n6TjeoXN1F7DA==", + "requires": { + "browserslist": "^4.0.0", + "caniuse-api": "^3.0.0", + "has": "^1.0.0", + "postcss": "^7.0.0" + } + }, + "postcss-reduce-transforms": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/postcss-reduce-transforms/-/postcss-reduce-transforms-4.0.2.tgz", + "integrity": "sha512-EEVig1Q2QJ4ELpJXMZR8Vt5DQx8/mo+dGWSR7vWXqcob2gQLyQGsionYcGKATXvQzMPn6DSN1vTN7yFximdIAg==", + "requires": { + "cssnano-util-get-match": "^4.0.0", + "has": "^1.0.0", + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0" + } + }, + "postcss-selector-parser": { + "version": "6.0.6", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-6.0.6.tgz", + "integrity": "sha512-9LXrvaaX3+mcv5xkg5kFwqSzSH1JIObIx51PrndZwlmznwXRfxMddDvo9gve3gVR8ZTKgoFDdWkbRFmEhT4PMg==", + "requires": { + "cssesc": "^3.0.0", + "util-deprecate": "^1.0.2" + } + }, + "postcss-svgo": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/postcss-svgo/-/postcss-svgo-4.0.3.tgz", + "integrity": "sha512-NoRbrcMWTtUghzuKSoIm6XV+sJdvZ7GZSc3wdBN0W19FTtp2ko8NqLsgoh/m9CzNhU3KLPvQmjIwtaNFkaFTvw==", + "requires": { + "postcss": "^7.0.0", + "postcss-value-parser": "^3.0.0", + "svgo": "^1.0.0" + } + }, + "postcss-unique-selectors": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/postcss-unique-selectors/-/postcss-unique-selectors-4.0.1.tgz", + "integrity": "sha512-+JanVaryLo9QwZjKrmJgkI4Fn8SBgRO6WXQBJi7KiAVPlmxikB5Jzc4EvXMT2H0/m0RjrVVm9rGNhZddm/8Spg==", + "requires": { + "alphanum-sort": "^1.0.0", + "postcss": "^7.0.0", + "uniqs": "^2.0.0" + } + }, + "postcss-value-parser": { + "version": "3.3.1", + "resolved": "https://registry.npmjs.org/postcss-value-parser/-/postcss-value-parser-3.3.1.tgz", + "integrity": "sha512-pISE66AbVkp4fDQ7VHBwRNXzAAKJjw4Vw7nWI/+Q3vuly7SNfgYXvm6i5IgFylHGK5sP/xHAbB7N49OS4gWNyQ==" + }, + "posthtml": { + "version": "0.11.6", + "resolved": "https://registry.npmjs.org/posthtml/-/posthtml-0.11.6.tgz", + "integrity": "sha512-C2hrAPzmRdpuL3iH0TDdQ6XCc9M7Dcc3zEW5BLerY65G4tWWszwv6nG/ksi6ul5i2mx22ubdljgktXCtNkydkw==", + "requires": { + "posthtml-parser": "^0.4.1", + "posthtml-render": "^1.1.5" + } + }, + "posthtml-parser": { + "version": "0.4.2", + "resolved": "https://registry.npmjs.org/posthtml-parser/-/posthtml-parser-0.4.2.tgz", + "integrity": "sha512-BUIorsYJTvS9UhXxPTzupIztOMVNPa/HtAm9KHni9z6qEfiJ1bpOBL5DfUOL9XAc3XkLIEzBzpph+Zbm4AdRAg==", + "requires": { + "htmlparser2": "^3.9.2" + }, + "dependencies": { + "domhandler": { + "version": "2.4.2", + "resolved": "https://registry.npmjs.org/domhandler/-/domhandler-2.4.2.tgz", + "integrity": "sha512-JiK04h0Ht5u/80fdLMCEmV4zkNh2BcoMFBmZ/91WtYZ8qVXSKjiw7fXMgFPnHcSZgOo3XdinHvmnDUeMf5R4wA==", + "requires": { + "domelementtype": "1" + } + }, + "entities": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/entities/-/entities-1.1.2.tgz", + "integrity": "sha512-f2LZMYl1Fzu7YSBKg+RoROelpOaNrcGmE9AZubeDfrCEia483oW4MI4VyFd5VNHIgQ/7qm1I0wUHK1eJnn2y2w==" + }, + "htmlparser2": { + "version": "3.10.1", + "resolved": "https://registry.npmjs.org/htmlparser2/-/htmlparser2-3.10.1.tgz", + "integrity": "sha512-IgieNijUMbkDovyoKObU1DUhm1iwNYE/fuifEoEHfd1oZKZDaONBSkal7Y01shxsM49R4XaMdGez3WnF9UfiCQ==", + "requires": { + "domelementtype": "^1.3.1", + "domhandler": "^2.3.0", + "domutils": "^1.5.1", + "entities": "^1.1.1", + "inherits": "^2.0.1", + "readable-stream": "^3.1.1" + } + }, + "readable-stream": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", + "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "requires": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + } + } + } + }, + "posthtml-render": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/posthtml-render/-/posthtml-render-1.4.0.tgz", + "integrity": "sha512-W1779iVHGfq0Fvh2PROhCe2QhB8mEErgqzo1wpIt36tCgChafP+hbXIhLDOM8ePJrZcFs0vkNEtdibEWVqChqw==" + }, + "prelude-ls": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/prelude-ls/-/prelude-ls-1.1.2.tgz", + "integrity": "sha1-IZMqVJ9eUv/ZqCf1cOBL5iqX2lQ=" + }, + "pretty-error": { + "version": "3.0.4", + "resolved": "https://registry.npmjs.org/pretty-error/-/pretty-error-3.0.4.tgz", + "integrity": "sha512-ytLFLfv1So4AO1UkoBF6GXQgJRaKbiSiGFICaOPNwQ3CMvBvXpLRubeQWyPGnsbV/t9ml9qto6IeCsho0aEvwQ==", + "requires": { + "lodash": "^4.17.20", + "renderkid": "^2.0.6" + } + }, + "process": { + "version": "0.11.10", + "resolved": "https://registry.npmjs.org/process/-/process-0.11.10.tgz", + "integrity": "sha1-czIwDoQBYb2j5podHZGn1LwW8YI=" + }, + "process-nextick-args": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/process-nextick-args/-/process-nextick-args-2.0.1.tgz", + "integrity": "sha512-3ouUOpQhtgrbOa17J7+uxOTpITYWaGP7/AhoR3+A+/1e9skrzelGi/dXzEYyvbxubEF6Wn2ypscTKiKJFFn1ag==" + }, + "promise-inflight": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/promise-inflight/-/promise-inflight-1.0.1.tgz", + "integrity": "sha1-mEcocL8igTL8vdhoEputEsPAKeM=" + }, + "promise-retry": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/promise-retry/-/promise-retry-1.1.1.tgz", + "integrity": "sha1-ZznpaOMFHaIM5kl/srUPaRHfPW0=", + "requires": { + "err-code": "^1.0.0", + "retry": "^0.10.0" + }, + "dependencies": { + "retry": { + "version": "0.10.1", + "resolved": "https://registry.npmjs.org/retry/-/retry-0.10.1.tgz", + "integrity": "sha1-52OI0heZLCUnUCQdPTlW/tmNj/Q=" + } + } + }, + "proto-list": { + "version": "1.2.4", + "resolved": "https://registry.npmjs.org/proto-list/-/proto-list-1.2.4.tgz", + "integrity": "sha1-IS1b/hMYMGpCD2QCuOJv85ZHqEk=" + }, + "proxy-addr": { + "version": "2.0.7", + "resolved": "https://registry.npmjs.org/proxy-addr/-/proxy-addr-2.0.7.tgz", + "integrity": "sha512-llQsMLSUDUPT44jdrU/O37qlnifitDP+ZwrmmZcoSKyLKvtZxpyV0n2/bD/N4tBAAZ/gJEdZU7KMraoK1+XYAg==", + "requires": { + "forwarded": "0.2.0", + "ipaddr.js": "1.9.1" + } + }, + "proxy-from-env": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/proxy-from-env/-/proxy-from-env-0.0.1.tgz", + "integrity": "sha1-snxJRunm1dutt1mKZDXTAUxM/Uk=" + }, + "prr": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/prr/-/prr-1.0.1.tgz", + "integrity": "sha1-0/wRS6BplaRexok/SEzrHXj19HY=" + }, + "pseudomap": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/pseudomap/-/pseudomap-1.0.2.tgz", + "integrity": "sha1-8FKijacOYYkX7wqKw0wa5aaChrM=" + }, + "psl": { + "version": "1.8.0", + "resolved": "https://registry.npmjs.org/psl/-/psl-1.8.0.tgz", + "integrity": "sha512-RIdOzyoavK+hA18OGGWDqUTsCLhtA7IcZ/6NCs4fFJaHBDab+pDDmDIByWFRQJq2Cd7r1OoQxBGKOaztq+hjIQ==" + }, + "public-encrypt": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/public-encrypt/-/public-encrypt-4.0.3.tgz", + "integrity": "sha512-zVpa8oKZSz5bTMTFClc1fQOnyyEzpl5ozpi1B5YcvBrdohMjH2rfsBtyXcuNuwjsDIXmBYlF2N5FlJYhR29t8Q==", + "requires": { + "bn.js": "^4.1.0", + "browserify-rsa": "^4.0.0", + "create-hash": "^1.1.0", + "parse-asn1": "^5.0.0", + "randombytes": "^2.0.1", + "safe-buffer": "^5.1.2" + }, + "dependencies": { + "bn.js": { + "version": "4.12.0", + "resolved": "https://registry.npmjs.org/bn.js/-/bn.js-4.12.0.tgz", + "integrity": "sha512-c98Bf3tPniI+scsdk237ku1Dc3ujXQTSgyiPUDEOe7tRkhrqridvh8klBv0HCEso1OLOYcHuCv/cS6DNxKH+ZA==" + } + } + }, + "pump": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/pump/-/pump-3.0.0.tgz", + "integrity": "sha512-LwZy+p3SFs1Pytd/jYct4wpv49HiYCqd9Rlc5ZVdk0V+8Yzv6jR5Blk3TRmPL1ft69TxP0IMZGJ+WPFU2BFhww==", + "requires": { + "end-of-stream": "^1.1.0", + "once": "^1.3.1" + } + }, + "pumpify": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/pumpify/-/pumpify-1.5.1.tgz", + "integrity": "sha512-oClZI37HvuUJJxSKKrC17bZ9Cu0ZYhEAGPsPUy9KlMUmv9dKX2o77RUmq7f3XjIxbwyGwYzbzQ1L2Ks8sIradQ==", + "requires": { + "duplexify": "^3.6.0", + "inherits": "^2.0.3", + "pump": "^2.0.0" + }, + "dependencies": { + "pump": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/pump/-/pump-2.0.1.tgz", + "integrity": "sha512-ruPMNRkN3MHP1cWJc9OWr+T/xDP0jhXYCLfJcBuX54hhfIBnaQmAUMfDcG4DM5UMWByBbJY69QSphm3jtDKIkA==", + "requires": { + "end-of-stream": "^1.1.0", + "once": "^1.3.1" + } + } + } + }, + "punycode": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-2.1.1.tgz", + "integrity": "sha512-XRsRjdf+j5ml+y/6GKHPZbrF/8p2Yga0JPtdqTIY2Xe5ohJPD9saDJJLPvp9+NSBprVvevdXZybnj2cv8OEd0A==" + }, + "purescript": { + "version": "0.14.2", + "resolved": "https://registry.npmjs.org/purescript/-/purescript-0.14.2.tgz", + "integrity": "sha512-kEXY5yUaG8a1FNN/IdtfNl4gcql7p76CPqnanMZ37GdtBZTcFK/SB24bp2rOAT1/N9qU8/corlra6uNf4+5pgQ==", + "requires": { + "purescript-installer": "^0.2.0" + } + }, + "purescript-installer": { + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/purescript-installer/-/purescript-installer-0.2.5.tgz", + "integrity": "sha512-fQAWWP5a7scuchXecjpU4r4KEgSPuS6bBnaP01k9f71qqD28HaJ2m4PXHFkhkR4oATAxTPIGCtmTwtVoiBOHog==", + "requires": { + "arch": "^2.1.1", + "byline": "^5.0.0", + "cacache": "^11.3.2", + "chalk": "^2.4.2", + "env-paths": "^2.2.0", + "execa": "^2.0.3", + "filesize": "^4.1.2", + "is-plain-obj": "^2.0.0", + "log-symbols": "^3.0.0", + "log-update": "^3.2.0", + "minimist": "^1.2.0", + "mkdirp": "^0.5.1", + "ms": "^2.1.2", + "once": "^1.4.0", + "pump": "^3.0.0", + "request": "^2.88.0", + "rimraf": "^2.6.3", + "tar": "^4.4.6", + "which": "^1.3.1", + "zen-observable": "^0.8.14" + }, + "dependencies": { + "filesize": { + "version": "4.2.1", + "resolved": "https://registry.npmjs.org/filesize/-/filesize-4.2.1.tgz", + "integrity": "sha512-bP82Hi8VRZX/TUBKfE24iiUGsB/sfm2WUrwTQyAzQrhO3V9IhcBBNBXMyzLY5orACxRyYJ3d2HeRVX+eFv4lmA==" + }, + "log-symbols": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/log-symbols/-/log-symbols-3.0.0.tgz", + "integrity": "sha512-dSkNGuI7iG3mfvDzUuYZyvk5dD9ocYCYzNU6CYDE6+Xqd+gwme6Z00NS3dUh8mq/73HaEtT7m6W+yUPtU6BZnQ==", + "requires": { + "chalk": "^2.4.2" + } + } + } + }, + "purescript-psa": { + "version": "0.8.2", + "resolved": "https://registry.npmjs.org/purescript-psa/-/purescript-psa-0.8.2.tgz", + "integrity": "sha512-4Olf0aQQrNCfcDLXQI3gJgINEQ+3U+4QPLmQ2LHX2L/YOXSwM7fOGIUs/wMm/FQnwERUyQmHKQTJKB4LIjE2fg==" + }, + "purgecss": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/purgecss/-/purgecss-2.3.0.tgz", + "integrity": "sha512-BE5CROfVGsx2XIhxGuZAT7rTH9lLeQx/6M0P7DTXQH4IUc3BBzs9JUzt4yzGf3JrH9enkeq6YJBe9CTtkm1WmQ==", + "requires": { + "commander": "^5.0.0", + "glob": "^7.0.0", + "postcss": "7.0.32", + "postcss-selector-parser": "^6.0.2" + }, + "dependencies": { + "commander": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/commander/-/commander-5.1.0.tgz", + "integrity": "sha512-P0CysNDQ7rtVw4QIQtm+MRxV66vKFSvlsQvGYXZWR3qFU0jlMKHZZZgw8e+8DSah4UDKMqnknRDQz+xuQXQ/Zg==" + }, + "postcss": { + "version": "7.0.32", + "resolved": "https://registry.npmjs.org/postcss/-/postcss-7.0.32.tgz", + "integrity": "sha512-03eXong5NLnNCD05xscnGKGDZ98CyzoqPSMjOe6SuoQY7Z2hIj0Ld1g/O/UQRuOle2aRtiIRDg9tDcTGAkLfKw==", + "requires": { + "chalk": "^2.4.2", + "source-map": "^0.6.1", + "supports-color": "^6.1.0" + } + }, + "supports-color": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-6.1.0.tgz", + "integrity": "sha512-qe1jfm1Mg7Nq/NSh6XE24gPXROEVsWHxC1LIx//XNlD9iw7YZQGjZNjYN7xGaEG6iKdA8EtNFW6R0gjnVXp+wQ==", + "requires": { + "has-flag": "^3.0.0" + } + } + } + }, + "purs-loader": { + "version": "3.7.2", + "resolved": "https://registry.npmjs.org/purs-loader/-/purs-loader-3.7.2.tgz", + "integrity": "sha512-Sidqk2RE1R2DTPt30I6G3p//c9pMaV9jd36NI3HXXSyf4Kf5X01FiP/2wMTJ8a5XKAXKdKCJ3WPqA8Whlxi0tg==", + "requires": { + "bluebird": "^3.3.5", + "chalk": "^1.1.3", + "cross-spawn": "^3.0.1", + "dargs": "^5.1.0", + "debug": "^2.6.0", + "globby": "^4.0.0", + "js-string-escape": "^1.0.1", + "loader-utils": "^1.0.2", + "lodash.difference": "^4.5.0", + "promise-retry": "^1.1.0" + }, + "dependencies": { + "ansi-regex": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", + "integrity": "sha1-w7M6te42DYbg5ijwRorn7yfWVN8=" + }, + "ansi-styles": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/ansi-styles/-/ansi-styles-2.2.1.tgz", + "integrity": "sha1-tDLdM1i2NM914eRmQ2gkBTPB3b4=" + }, + "chalk": { + "version": "1.1.3", + "resolved": "https://registry.npmjs.org/chalk/-/chalk-1.1.3.tgz", + "integrity": "sha1-qBFcVeSnAv5NFQq9OHKCKn4J/Jg=", + "requires": { + "ansi-styles": "^2.2.1", + "escape-string-regexp": "^1.0.2", + "has-ansi": "^2.0.0", + "strip-ansi": "^3.0.0", + "supports-color": "^2.0.0" + } + }, + "cross-spawn": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/cross-spawn/-/cross-spawn-3.0.1.tgz", + "integrity": "sha1-ElYDfsufDF9549bvE14wdwGEuYI=", + "requires": { + "lru-cache": "^4.0.1", + "which": "^1.2.9" + } + }, + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "glob": { + "version": "6.0.4", + "resolved": "https://registry.npmjs.org/glob/-/glob-6.0.4.tgz", + "integrity": "sha1-DwiGD2oVUSey+t1PnOJLGqtuTSI=", + "requires": { + "inflight": "^1.0.4", + "inherits": "2", + "minimatch": "2 || 3", + "once": "^1.3.0", + "path-is-absolute": "^1.0.0" + } + }, + "globby": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/globby/-/globby-4.1.0.tgz", + "integrity": "sha1-CA9UVJ7BuCpsYOYx/ILhIR2+lfg=", + "requires": { + "array-union": "^1.0.1", + "arrify": "^1.0.0", + "glob": "^6.0.1", + "object-assign": "^4.0.1", + "pify": "^2.0.0", + "pinkie-promise": "^2.0.0" + } + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + }, + "pify": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/pify/-/pify-2.3.0.tgz", + "integrity": "sha1-7RQaasBDqEnqWISY59yosVMw6Qw=" + }, + "strip-ansi": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-3.0.1.tgz", + "integrity": "sha1-ajhfuIU9lS1f8F0Oiq+UJ43GPc8=", + "requires": { + "ansi-regex": "^2.0.0" + } + }, + "supports-color": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-2.0.0.tgz", + "integrity": "sha1-U10EXOa2Nj+kARcIRimZXp3zJMc=" + } + } + }, + "q": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/q/-/q-1.5.1.tgz", + "integrity": "sha1-fjL3W0E4EpHQRhHxvxQQmsAGUdc=" + }, + "qs": { + "version": "6.5.2", + "resolved": "https://registry.npmjs.org/qs/-/qs-6.5.2.tgz", + "integrity": "sha512-N5ZAX4/LxJmF+7wN74pUD6qAh9/wnvdQcjq9TZjevvXzSUo7bfmw91saqMjzGS2xq91/odN2dW/WOl7qQHNDGA==" + }, + "querystring": { + "version": "0.2.0", + "resolved": "https://registry.npmjs.org/querystring/-/querystring-0.2.0.tgz", + "integrity": "sha1-sgmEkgO7Jd+CDadW50cAWHhSFiA=" + }, + "querystring-es3": { + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/querystring-es3/-/querystring-es3-0.2.1.tgz", + "integrity": "sha1-nsYfeQSYdXB9aUFFlv2Qek1xHnM=" + }, + "querystringify": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/querystringify/-/querystringify-2.2.0.tgz", + "integrity": "sha512-FIqgj2EUvTa7R50u0rGsyTftzjYmv/a3hO345bZNrqabNqjtgiDMgmo4mkUjd+nzU5oF3dClKqFIPUKybUyqoQ==" + }, + "quote-stream": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/quote-stream/-/quote-stream-1.0.2.tgz", + "integrity": "sha1-hJY/jJwmuULhU/7rU6rnRlK34LI=", + "requires": { + "buffer-equal": "0.0.1", + "minimist": "^1.1.3", + "through2": "^2.0.0" + } + }, + "randombytes": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/randombytes/-/randombytes-2.1.0.tgz", + "integrity": "sha512-vYl3iOX+4CKUWuxGi9Ukhie6fsqXqS9FE2Zaic4tNFD2N2QQaXOMFbuKK4QmDHC0JO6B1Zp41J0LpT0oR68amQ==", + "requires": { + "safe-buffer": "^5.1.0" + } + }, + "randomfill": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/randomfill/-/randomfill-1.0.4.tgz", + "integrity": "sha512-87lcbR8+MhcWcUiQ+9e+Rwx8MyR2P7qnt15ynUlbm3TU/fjbgz4GsvfSUDTemtCCtVCqb4ZcEFlyPNTh9bBTLw==", + "requires": { + "randombytes": "^2.0.5", + "safe-buffer": "^5.1.0" + } + }, + "range-parser": { + "version": "1.2.1", + "resolved": "https://registry.npmjs.org/range-parser/-/range-parser-1.2.1.tgz", + "integrity": "sha512-Hrgsx+orqoygnmhFbKaHE6c296J+HTAQXoxEF6gNupROmmGJRoyzfG3ccAveqCBrwr/2yxQ5BVd/GTl5agOwSg==" + }, + "raw-body": { + "version": "2.4.0", + "resolved": "https://registry.npmjs.org/raw-body/-/raw-body-2.4.0.tgz", + "integrity": "sha512-4Oz8DUIwdvoa5qMJelxipzi/iJIi40O5cGV1wNYp5hvZP8ZN0T+jiNkL0QepXs+EsQ9XJ8ipEDoiH70ySUJP3Q==", + "requires": { + "bytes": "3.1.0", + "http-errors": "1.7.2", + "iconv-lite": "0.4.24", + "unpipe": "1.0.0" + }, + "dependencies": { + "bytes": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/bytes/-/bytes-3.1.0.tgz", + "integrity": "sha512-zauLjrfCG+xvoyaqLoV8bLVXXNGC4JqlxFCutSDWA6fJrTo2ZuvLYTqZ7aHBLZSMOopbzwv8f+wZcVzfVTI2Dg==" + }, + "http-errors": { + "version": "1.7.2", + "resolved": "https://registry.npmjs.org/http-errors/-/http-errors-1.7.2.tgz", + "integrity": "sha512-uUQBt3H/cSIVfch6i1EuPNy/YsRSOUBXTVfZ+yR7Zjez3qjBz6i9+i4zjNaoqcoFVI4lQJ5plg63TvGfRSDCRg==", + "requires": { + "depd": "~1.1.2", + "inherits": "2.0.3", + "setprototypeof": "1.1.1", + "statuses": ">= 1.5.0 < 2", + "toidentifier": "1.0.0" + } + }, + "inherits": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.3.tgz", + "integrity": "sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4=" + } + } + }, + "readable-stream": { + "version": "2.3.7", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.7.tgz", + "integrity": "sha512-Ebho8K4jIbHAxnuxi7o42OrZgF/ZTNcsZj6nRKyUmkhLFq8CHItp/fy6hQZuZmP/n3yZ9VBUbp4zz/mX8hmYPw==", + "requires": { + "core-util-is": "~1.0.0", + "inherits": "~2.0.3", + "isarray": "~1.0.0", + "process-nextick-args": "~2.0.0", + "safe-buffer": "~5.1.1", + "string_decoder": "~1.1.1", + "util-deprecate": "~1.0.1" + } + }, + "readdirp": { + "version": "2.2.1", + "resolved": "https://registry.npmjs.org/readdirp/-/readdirp-2.2.1.tgz", + "integrity": "sha512-1JU/8q+VgFZyxwrJ+SVIOsh+KywWGpds3NTqikiKpDMZWScmAYyKIgqkO+ARvNWJfXeXR1zxz7aHF4u4CyH6vQ==", + "requires": { + "graceful-fs": "^4.1.11", + "micromatch": "^3.1.10", + "readable-stream": "^2.0.2" + } + }, + "rechoir": { + "version": "0.7.0", + "resolved": "https://registry.npmjs.org/rechoir/-/rechoir-0.7.0.tgz", + "integrity": "sha512-ADsDEH2bvbjltXEP+hTIAmeFekTFK0V2BTxMkok6qILyAJEXV0AFfoWcAq4yfll5VdIMd/RVXq0lR+wQi5ZU3Q==", + "requires": { + "resolve": "^1.9.0" + } + }, + "regenerate": { + "version": "1.4.2", + "resolved": "https://registry.npmjs.org/regenerate/-/regenerate-1.4.2.tgz", + "integrity": "sha512-zrceR/XhGYU/d/opr2EKO7aRHUeiBI8qjtfHqADTwZd6Szfy16la6kqD0MIUs5z5hx6AaKa+PixpPrR289+I0A==" + }, + "regenerate-unicode-properties": { + "version": "8.2.0", + "resolved": "https://registry.npmjs.org/regenerate-unicode-properties/-/regenerate-unicode-properties-8.2.0.tgz", + "integrity": "sha512-F9DjY1vKLo/tPePDycuH3dn9H1OTPIkVD9Kz4LODu+F2C75mgjAJ7x/gwy6ZcSNRAAkhNlJSOHRe8k3p+K9WhA==", + "requires": { + "regenerate": "^1.4.0" + } + }, + "regenerator-runtime": { + "version": "0.13.7", + "resolved": "https://registry.npmjs.org/regenerator-runtime/-/regenerator-runtime-0.13.7.tgz", + "integrity": "sha512-a54FxoJDIr27pgf7IgeQGxmqUNYrcV338lf/6gH456HZ/PhX+5BcwHXG9ajESmwe6WRO0tAzRUrRmNONWgkrew==" + }, + "regenerator-transform": { + "version": "0.14.5", + "resolved": "https://registry.npmjs.org/regenerator-transform/-/regenerator-transform-0.14.5.tgz", + "integrity": "sha512-eOf6vka5IO151Jfsw2NO9WpGX58W6wWmefK3I1zEGr0lOD0u8rwPaNqQL1aRxUaxLeKO3ArNh3VYg1KbaD+FFw==", + "requires": { + "@babel/runtime": "^7.8.4" + }, + "dependencies": { + "@babel/runtime": { + "version": "7.14.6", + "resolved": "https://registry.npmjs.org/@babel/runtime/-/runtime-7.14.6.tgz", + "integrity": "sha512-/PCB2uJ7oM44tz8YhC4Z/6PeOKXp4K588f+5M3clr1M4zbqztlo0XEfJ2LEzj/FgwfgGcIdl8n7YYjTCI0BYwg==", + "requires": { + "regenerator-runtime": "^0.13.4" + } + } + } + }, + "regex-not": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/regex-not/-/regex-not-1.0.2.tgz", + "integrity": "sha512-J6SDjUgDxQj5NusnOtdFxDwN/+HWykR8GELwctJ7mdqhcyy1xEc4SRFHUXvxTp661YaVKAjfRLZ9cCqS6tn32A==", + "requires": { + "extend-shallow": "^3.0.2", + "safe-regex": "^1.1.0" + } + }, + "regexp.prototype.flags": { + "version": "1.3.1", + "resolved": "https://registry.npmjs.org/regexp.prototype.flags/-/regexp.prototype.flags-1.3.1.tgz", + "integrity": "sha512-JiBdRBq91WlY7uRJ0ds7R+dU02i6LKi8r3BuQhNXn+kmeLN+EfHhfjqMRis1zJxnlu88hq/4dx0P2OP3APRTOA==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3" + } + }, + "regexpu-core": { + "version": "4.7.1", + "resolved": "https://registry.npmjs.org/regexpu-core/-/regexpu-core-4.7.1.tgz", + "integrity": "sha512-ywH2VUraA44DZQuRKzARmw6S66mr48pQVva4LBeRhcOltJ6hExvWly5ZjFLYo67xbIxb6W1q4bAGtgfEl20zfQ==", + "requires": { + "regenerate": "^1.4.0", + "regenerate-unicode-properties": "^8.2.0", + "regjsgen": "^0.5.1", + "regjsparser": "^0.6.4", + "unicode-match-property-ecmascript": "^1.0.4", + "unicode-match-property-value-ecmascript": "^1.2.0" + } + }, + "regjsgen": { + "version": "0.5.2", + "resolved": "https://registry.npmjs.org/regjsgen/-/regjsgen-0.5.2.tgz", + "integrity": "sha512-OFFT3MfrH90xIW8OOSyUrk6QHD5E9JOTeGodiJeBS3J6IwlgzJMNE/1bZklWz5oTg+9dCMyEetclvCVXOPoN3A==" + }, + "regjsparser": { + "version": "0.6.9", + "resolved": "https://registry.npmjs.org/regjsparser/-/regjsparser-0.6.9.tgz", + "integrity": "sha512-ZqbNRz1SNjLAiYuwY0zoXW8Ne675IX5q+YHioAGbCw4X96Mjl2+dcX9B2ciaeyYjViDAfvIjFpQjJgLttTEERQ==", + "requires": { + "jsesc": "~0.5.0" + }, + "dependencies": { + "jsesc": { + "version": "0.5.0", + "resolved": "https://registry.npmjs.org/jsesc/-/jsesc-0.5.0.tgz", + "integrity": "sha1-597mbjXW/Bb3EP6R1c9p9w8IkR0=" + } + } + }, + "relateurl": { + "version": "0.2.7", + "resolved": "https://registry.npmjs.org/relateurl/-/relateurl-0.2.7.tgz", + "integrity": "sha1-VNvzd+UUQKypCkzSdGANP/LYiKk=" + }, + "remove-trailing-separator": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/remove-trailing-separator/-/remove-trailing-separator-1.1.0.tgz", + "integrity": "sha1-wkvOKig62tW8P1jg1IJJuSN52O8=" + }, + "renderkid": { + "version": "2.0.7", + "resolved": "https://registry.npmjs.org/renderkid/-/renderkid-2.0.7.tgz", + "integrity": "sha512-oCcFyxaMrKsKcTY59qnCAtmDVSLfPbrv6A3tVbPdFMMrv5jaK10V6m40cKsoPNhAqN6rmHW9sswW4o3ruSrwUQ==", + "requires": { + "css-select": "^4.1.3", + "dom-converter": "^0.2.0", + "htmlparser2": "^6.1.0", + "lodash": "^4.17.21", + "strip-ansi": "^3.0.1" + }, + "dependencies": { + "ansi-regex": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", + "integrity": "sha1-w7M6te42DYbg5ijwRorn7yfWVN8=" + }, + "css-select": { + "version": "4.1.3", + "resolved": "https://registry.npmjs.org/css-select/-/css-select-4.1.3.tgz", + "integrity": "sha512-gT3wBNd9Nj49rAbmtFHj1cljIAOLYSX1nZ8CB7TBO3INYckygm5B7LISU/szY//YmdiSLbJvDLOx9VnMVpMBxA==", + "requires": { + "boolbase": "^1.0.0", + "css-what": "^5.0.0", + "domhandler": "^4.2.0", + "domutils": "^2.6.0", + "nth-check": "^2.0.0" + } + }, + "css-what": { + "version": "5.0.1", + "resolved": "https://registry.npmjs.org/css-what/-/css-what-5.0.1.tgz", + "integrity": "sha512-FYDTSHb/7KXsWICVsxdmiExPjCfRC4qRFBdVwv7Ax9hMnvMmEjP9RfxTEZ3qPZGmADDn2vAKSo9UcN1jKVYscg==" + }, + "dom-serializer": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/dom-serializer/-/dom-serializer-1.3.2.tgz", + "integrity": "sha512-5c54Bk5Dw4qAxNOI1pFEizPSjVsx5+bpJKmL2kPn8JhBUq2q09tTCa3mjijun2NfK78NMouDYNMBkOrPZiS+ig==", + "requires": { + "domelementtype": "^2.0.1", + "domhandler": "^4.2.0", + "entities": "^2.0.0" + } + }, + "domelementtype": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/domelementtype/-/domelementtype-2.2.0.tgz", + "integrity": "sha512-DtBMo82pv1dFtUmHyr48beiuq792Sxohr+8Hm9zoxklYPfa6n0Z3Byjj2IV7bmr2IyqClnqEQhfgHJJ5QF0R5A==" + }, + "domutils": { + "version": "2.7.0", + "resolved": "https://registry.npmjs.org/domutils/-/domutils-2.7.0.tgz", + "integrity": "sha512-8eaHa17IwJUPAiB+SoTYBo5mCdeMgdcAoXJ59m6DT1vw+5iLS3gNoqYaRowaBKtGVrOF1Jz4yDTgYKLK2kvfJg==", + "requires": { + "dom-serializer": "^1.0.1", + "domelementtype": "^2.2.0", + "domhandler": "^4.2.0" + } + }, + "nth-check": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/nth-check/-/nth-check-2.0.0.tgz", + "integrity": "sha512-i4sc/Kj8htBrAiH1viZ0TgU8Y5XqCaV/FziYK6TBczxmeKm3AEFWqqF3195yKudrarqy7Zu80Ra5dobFjn9X/Q==", + "requires": { + "boolbase": "^1.0.0" + } + }, + "strip-ansi": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-3.0.1.tgz", + "integrity": "sha1-ajhfuIU9lS1f8F0Oiq+UJ43GPc8=", + "requires": { + "ansi-regex": "^2.0.0" + } + } + } + }, + "repeat-element": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/repeat-element/-/repeat-element-1.1.4.tgz", + "integrity": "sha512-LFiNfRcSu7KK3evMyYOuCzv3L10TW7yC1G2/+StMjK8Y6Vqd2MG7r/Qjw4ghtuCOjFvlnms/iMmLqpvW/ES/WQ==" + }, + "repeat-string": { + "version": "1.6.1", + "resolved": "https://registry.npmjs.org/repeat-string/-/repeat-string-1.6.1.tgz", + "integrity": "sha1-jcrkcOHIirwtYA//Sndihtp15jc=" + }, + "request": { + "version": "2.88.2", + "resolved": "https://registry.npmjs.org/request/-/request-2.88.2.tgz", + "integrity": "sha512-MsvtOrfG9ZcrOwAW+Qi+F6HbD0CWXEh9ou77uOb7FM2WPhwT7smM833PzanhJLsgXjN89Ir6V2PczXNnMpwKhw==", + "requires": { + "aws-sign2": "~0.7.0", + "aws4": "^1.8.0", + "caseless": "~0.12.0", + "combined-stream": "~1.0.6", + "extend": "~3.0.2", + "forever-agent": "~0.6.1", + "form-data": "~2.3.2", + "har-validator": "~5.1.3", + "http-signature": "~1.2.0", + "is-typedarray": "~1.0.0", + "isstream": "~0.1.2", + "json-stringify-safe": "~5.0.1", + "mime-types": "~2.1.19", + "oauth-sign": "~0.9.0", + "performance-now": "^2.1.0", + "qs": "~6.5.2", + "safe-buffer": "^5.1.2", + "tough-cookie": "~2.5.0", + "tunnel-agent": "^0.6.0", + "uuid": "^3.3.2" + } + }, + "request-promise-core": { + "version": "1.1.4", + "resolved": "https://registry.npmjs.org/request-promise-core/-/request-promise-core-1.1.4.tgz", + "integrity": "sha512-TTbAfBBRdWD7aNNOoVOBH4pN/KigV6LyapYNNlAPA8JwbovRti1E88m3sYAwsLi5ryhPKsE9APwnjFTgdUjTpw==", + "requires": { + "lodash": "^4.17.19" + } + }, + "request-promise-native": { + "version": "1.0.9", + "resolved": "https://registry.npmjs.org/request-promise-native/-/request-promise-native-1.0.9.tgz", + "integrity": "sha512-wcW+sIUiWnKgNY0dqCpOZkUbF/I+YPi+f09JZIDa39Ec+q82CpSYniDp+ISgTTbKmnpJWASeJBPZmoxH84wt3g==", + "requires": { + "request-promise-core": "1.1.4", + "stealthy-require": "^1.1.1", + "tough-cookie": "^2.3.3" + } + }, + "require-directory": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/require-directory/-/require-directory-2.1.1.tgz", + "integrity": "sha1-jGStX9MNqxyXbiNE/+f3kqam30I=" + }, + "require-main-filename": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/require-main-filename/-/require-main-filename-2.0.0.tgz", + "integrity": "sha512-NKN5kMDylKuldxYLSUfrbo5Tuzh4hd+2E8NPPX02mZtn1VuREQToYe/ZdlJy+J3uCpfaiGF05e7B8W0iXbQHmg==" + }, + "requires-port": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/requires-port/-/requires-port-0.0.1.tgz", + "integrity": "sha1-S0QUQR2d98hVmV3YmajHiilRwW0=" + }, + "resolve": { + "version": "1.20.0", + "resolved": "https://registry.npmjs.org/resolve/-/resolve-1.20.0.tgz", + "integrity": "sha512-wENBPt4ySzg4ybFQW2TT1zMQucPK95HSh/nq2CFTZVOGut2+pQvSsgtda4d26YrYcr067wjbmzOG8byDPBX63A==", + "requires": { + "is-core-module": "^2.2.0", + "path-parse": "^1.0.6" + } + }, + "resolve-cwd": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/resolve-cwd/-/resolve-cwd-3.0.0.tgz", + "integrity": "sha512-OrZaX2Mb+rJCpH/6CpSqt9xFVpN++x01XnN2ie9g6P5/3xelLAkXWVADpdz1IHD/KFfEXyE6V0U01OQ3UO2rEg==", + "requires": { + "resolve-from": "^5.0.0" + }, + "dependencies": { + "resolve-from": { + "version": "5.0.0", + "resolved": "https://registry.npmjs.org/resolve-from/-/resolve-from-5.0.0.tgz", + "integrity": "sha512-qYg9KP24dD5qka9J47d0aVky0N+b4fTU89LN9iDnjB5waksiC49rvMB0PrUJQGoTmH50XPiqOvAjDfaijGxYZw==" + } + } + }, + "resolve-from": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/resolve-from/-/resolve-from-3.0.0.tgz", + "integrity": "sha1-six699nWiBvItuZTM17rywoYh0g=" + }, + "resolve-url": { + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/resolve-url/-/resolve-url-0.2.1.tgz", + "integrity": "sha1-LGN/53yJOv0qZj/iGqkIAGjiBSo=" + }, + "restore-cursor": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/restore-cursor/-/restore-cursor-2.0.0.tgz", + "integrity": "sha1-n37ih/gv0ybU/RYpI9YhKe7g368=", + "requires": { + "onetime": "^2.0.0", + "signal-exit": "^3.0.2" + } + }, + "ret": { + "version": "0.1.15", + "resolved": "https://registry.npmjs.org/ret/-/ret-0.1.15.tgz", + "integrity": "sha512-TTlYpa+OL+vMMNG24xSlQGEJ3B/RzEfUlLct7b5G/ytav+wPrplCpVMFuwzXbkecJrb6IYo1iFb0S9v37754mg==" + }, + "retry": { + "version": "0.12.0", + "resolved": "https://registry.npmjs.org/retry/-/retry-0.12.0.tgz", + "integrity": "sha1-G0KmJmoh8HQh0bC1S33BZ7AcATs=" + }, + "rgb-regex": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/rgb-regex/-/rgb-regex-1.0.1.tgz", + "integrity": "sha1-wODWiC3w4jviVKR16O3UGRX+rrE=" + }, + "rgba-regex": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/rgba-regex/-/rgba-regex-1.0.0.tgz", + "integrity": "sha1-QzdOLiyglosO8VI0YLfXMP8i7rM=" + }, + "rimraf": { + "version": "2.7.1", + "resolved": "https://registry.npmjs.org/rimraf/-/rimraf-2.7.1.tgz", + "integrity": "sha512-uWjbaKIK3T1OSVptzX7Nl6PvQ3qAGtKEtVRjRuazjfL3Bx5eI409VZSqgND+4UNnmzLVdPj9FqFJNPqBZFve4w==", + "requires": { + "glob": "^7.1.3" + } + }, + "ripemd160": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/ripemd160/-/ripemd160-2.0.2.tgz", + "integrity": "sha512-ii4iagi25WusVoiC4B4lq7pbXfAp3D9v5CwfkY33vffw2+pkDjY1D8GaN7spsxvCSx8dkPqOZCEZyfxcmJG2IA==", + "requires": { + "hash-base": "^3.0.0", + "inherits": "^2.0.1" + } + }, + "run-queue": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/run-queue/-/run-queue-1.0.3.tgz", + "integrity": "sha1-6Eg5bwV9Ij8kOGkkYY4laUFh7Ec=", + "requires": { + "aproba": "^1.1.1" + } + }, + "safe-buffer": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/safe-buffer/-/safe-buffer-5.1.2.tgz", + "integrity": "sha512-Gd2UZBJDkXlY7GbJxfsE8/nvKkUEU1G38c1siN6QP6a9PT9MmHB8GnpscSmMJSoF8LOIrt8ud/wPtojys4G6+g==" + }, + "safe-regex": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/safe-regex/-/safe-regex-1.1.0.tgz", + "integrity": "sha1-QKNmnzsHfR6UPURinhV91IAjvy4=", + "requires": { + "ret": "~0.1.10" + } + }, + "safer-buffer": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/safer-buffer/-/safer-buffer-2.1.2.tgz", + "integrity": "sha512-YZo3K82SD7Riyi0E1EQPojLz7kpepnSQI9IyPbHHg1XXXevb5dJI7tpyN2ADxGcQbHG7vcyRHk0cbwqcQriUtg==" + }, + "safer-eval": { + "version": "1.3.6", + "resolved": "https://registry.npmjs.org/safer-eval/-/safer-eval-1.3.6.tgz", + "integrity": "sha512-DN9tBsZgtUOHODzSfO1nGCLhZtxc7Qq/d8/2SNxQZ9muYXZspSh1fO7HOsrf4lcelBNviAJLCxB/ggmG+jV1aw==", + "requires": { + "clones": "^1.2.0" + } + }, + "sax": { + "version": "1.2.4", + "resolved": "https://registry.npmjs.org/sax/-/sax-1.2.4.tgz", + "integrity": "sha512-NqVDv9TpANUjFm0N8uM5GxL36UgKi9/atZw+x7YFnQ8ckwFGKrl4xX4yWtrey3UJm5nP1kUbnYgLopqWNSRhWw==" + }, + "saxes": { + "version": "3.1.11", + "resolved": "https://registry.npmjs.org/saxes/-/saxes-3.1.11.tgz", + "integrity": "sha512-Ydydq3zC+WYDJK1+gRxRapLIED9PWeSuuS41wqyoRmzvhhh9nc+QQrVMKJYzJFULazeGhzSV0QleN2wD3boh2g==", + "requires": { + "xmlchars": "^2.1.1" + } + }, + "schema-utils": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/schema-utils/-/schema-utils-3.0.0.tgz", + "integrity": "sha512-6D82/xSzO094ajanoOSbe4YvXWMfn2A//8Y1+MUqFAJul5Bs+yn36xbK9OtNDcRVSBJ9jjeoXftM6CfztsjOAA==", + "requires": { + "@types/json-schema": "^7.0.6", + "ajv": "^6.12.5", + "ajv-keywords": "^3.5.2" + } + }, + "select-hose": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/select-hose/-/select-hose-2.0.0.tgz", + "integrity": "sha1-Yl2GWPhlr0Psliv8N2o3NZpJlMo=" + }, + "selfsigned": { + "version": "1.10.11", + "resolved": "https://registry.npmjs.org/selfsigned/-/selfsigned-1.10.11.tgz", + "integrity": "sha512-aVmbPOfViZqOZPgRBT0+3u4yZFHpmnIghLMlAcb5/xhp5ZtB/RVnKhz5vl2M32CLXAqR4kha9zfhNg0Lf/sxKA==", + "requires": { + "node-forge": "^0.10.0" + }, + "dependencies": { + "node-forge": { + "version": "0.10.0", + "resolved": "https://registry.npmjs.org/node-forge/-/node-forge-0.10.0.tgz", + "integrity": "sha512-PPmu8eEeG9saEUvI97fm4OYxXVB6bFvyNTyiUOBichBpFG8A1Ljw3bY62+5oOjDEMHRnd0Y7HQ+x7uzxOzC6JA==" + } + } + }, + "semver": { + "version": "5.7.1", + "resolved": "https://registry.npmjs.org/semver/-/semver-5.7.1.tgz", + "integrity": "sha512-sauaDf/PZdVgrLTNYHRtpXa1iRiKcaebiKQ1BJdpQlWH2lCvexQdX55snPFyK7QzpudqbCI0qXFfOasHdyNDGQ==" + }, + "send": { + "version": "0.17.1", + "resolved": "https://registry.npmjs.org/send/-/send-0.17.1.tgz", + "integrity": "sha512-BsVKsiGcQMFwT8UxypobUKyv7irCNRHk1T0G680vk88yf6LBByGcZJOTJCrTP2xVN6yI+XjPJcNuE3V4fT9sAg==", + "requires": { + "debug": "2.6.9", + "depd": "~1.1.2", + "destroy": "~1.0.4", + "encodeurl": "~1.0.2", + "escape-html": "~1.0.3", + "etag": "~1.8.1", + "fresh": "0.5.2", + "http-errors": "~1.7.2", + "mime": "1.6.0", + "ms": "2.1.1", + "on-finished": "~2.3.0", + "range-parser": "~1.2.1", + "statuses": "~1.5.0" + }, + "dependencies": { + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + }, + "dependencies": { + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + } + } + }, + "ms": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.1.1.tgz", + "integrity": "sha512-tgp+dl5cGk28utYktBsrFqA7HKgrhgPsg6Z/EfhWI4gl1Hwq8B/GmY/0oXZ6nF8hDVesS/FpnYaD/kOWhYQvyg==" + } + } + }, + "serialize-javascript": { + "version": "6.0.0", + "resolved": "https://registry.npmjs.org/serialize-javascript/-/serialize-javascript-6.0.0.tgz", + "integrity": "sha512-Qr3TosvguFt8ePWqsvRfrKyQXIiW+nGbYpy8XK24NQHE83caxWt+mIymTT19DGFbNWNLfEwsrkSmN64lVWB9ag==", + "requires": { + "randombytes": "^2.1.0" + } + }, + "serialize-to-js": { + "version": "1.2.2", + "resolved": "https://registry.npmjs.org/serialize-to-js/-/serialize-to-js-1.2.2.tgz", + "integrity": "sha512-mUc8vA5iJghe+O+3s0YDGFLMJcqitVFk787YKiv8a4sf6RX5W0u81b+gcHrp15O0fFa010dRBVZvwcKXOWsL9Q==", + "requires": { + "js-beautify": "^1.8.9", + "safer-eval": "^1.3.0" + } + }, + "serve-index": { + "version": "1.9.1", + "resolved": "https://registry.npmjs.org/serve-index/-/serve-index-1.9.1.tgz", + "integrity": "sha1-03aNabHn2C5c4FD/9bRTvqEqkjk=", + "requires": { + "accepts": "~1.3.4", + "batch": "0.6.1", + "debug": "2.6.9", + "escape-html": "~1.0.3", + "http-errors": "~1.6.2", + "mime-types": "~2.1.17", + "parseurl": "~1.3.2" + }, + "dependencies": { + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "http-errors": { + "version": "1.6.3", + "resolved": "https://registry.npmjs.org/http-errors/-/http-errors-1.6.3.tgz", + "integrity": "sha1-i1VoC7S+KDoLW/TqLjhYC+HZMg0=", + "requires": { + "depd": "~1.1.2", + "inherits": "2.0.3", + "setprototypeof": "1.1.0", + "statuses": ">= 1.4.0 < 2" + } + }, + "inherits": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.3.tgz", + "integrity": "sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4=" + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + }, + "setprototypeof": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/setprototypeof/-/setprototypeof-1.1.0.tgz", + "integrity": "sha512-BvE/TwpZX4FXExxOxZyRGQQv651MSwmWKZGqvmPcRIjDqWub67kTKuIMx43cZZrS/cBBzwBcNDWoFxt2XEFIpQ==" + } + } + }, + "serve-static": { + "version": "1.14.1", + "resolved": "https://registry.npmjs.org/serve-static/-/serve-static-1.14.1.tgz", + "integrity": "sha512-JMrvUwE54emCYWlTI+hGrGv5I8dEwmco/00EvkzIIsR7MqrHonbD9pO2MOfFnpFntl7ecpZs+3mW+XbQZu9QCg==", + "requires": { + "encodeurl": "~1.0.2", + "escape-html": "~1.0.3", + "parseurl": "~1.3.3", + "send": "0.17.1" + } + }, + "set-blocking": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/set-blocking/-/set-blocking-2.0.0.tgz", + "integrity": "sha1-BF+XgtARrppoA93TgrJDkrPYkPc=" + }, + "set-value": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/set-value/-/set-value-2.0.1.tgz", + "integrity": "sha512-JxHc1weCN68wRY0fhCoXpyK55m/XPHafOmK4UWD7m2CI14GMcFypt4w/0+NV5f/ZMby2F6S2wwA7fgynh9gWSw==", + "requires": { + "extend-shallow": "^2.0.1", + "is-extendable": "^0.1.1", + "is-plain-object": "^2.0.3", + "split-string": "^3.0.1" + }, + "dependencies": { + "extend-shallow": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz", + "integrity": "sha1-Ua99YUrZqfYQ6huvu5idaxxWiQ8=", + "requires": { + "is-extendable": "^0.1.0" + } + } + } + }, + "setimmediate": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/setimmediate/-/setimmediate-1.0.5.tgz", + "integrity": "sha1-KQy7Iy4waULX1+qbg3Mqt4VvgoU=" + }, + "setprototypeof": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/setprototypeof/-/setprototypeof-1.1.1.tgz", + "integrity": "sha512-JvdAWfbXeIGaZ9cILp38HntZSFSo3mWg6xGcJJsd+d4aRMOqauag1C63dJfDw7OaMYwEbHMOxEZ1lqVRYP2OAw==" + }, + "sha.js": { + "version": "2.4.11", + "resolved": "https://registry.npmjs.org/sha.js/-/sha.js-2.4.11.tgz", + "integrity": "sha512-QMEp5B7cftE7APOjk5Y6xgrbWu+WkLVQwk8JNjZ8nKRciZaByEW6MubieAiToS7+dwvrjGhH8jRXz3MVd0AYqQ==", + "requires": { + "inherits": "^2.0.1", + "safe-buffer": "^5.0.1" + } + }, + "shallow-clone": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/shallow-clone/-/shallow-clone-3.0.1.tgz", + "integrity": "sha512-/6KqX+GVUdqPuPPd2LxDDxzX6CAbjJehAAOKlNpqqUpAqPM6HeL8f+o3a+JsyGjn2lv0WY8UsTgUJjU9Ok55NA==", + "requires": { + "kind-of": "^6.0.2" + } + }, + "shallow-copy": { + "version": "0.0.1", + "resolved": "https://registry.npmjs.org/shallow-copy/-/shallow-copy-0.0.1.tgz", + "integrity": "sha1-QV9CcC1z2BAzApLMXuhurhoRoXA=" + }, + "shebang-command": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/shebang-command/-/shebang-command-1.2.0.tgz", + "integrity": "sha1-RKrGW2lbAzmJaMOfNj/uXer98eo=", + "requires": { + "shebang-regex": "^1.0.0" + } + }, + "shebang-regex": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/shebang-regex/-/shebang-regex-1.0.0.tgz", + "integrity": "sha1-2kL0l0DAtC2yypcoVxyxkMmO/qM=" + }, + "sigmund": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/sigmund/-/sigmund-1.0.1.tgz", + "integrity": "sha1-P/IfGYytIXX587eBhT/ZTQ0ZtZA=" + }, + "signal-exit": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/signal-exit/-/signal-exit-3.0.3.tgz", + "integrity": "sha512-VUJ49FC8U1OxwZLxIbTTrDvLnf/6TDgxZcK8wxR8zs13xpx7xbG60ndBlhNrFi2EMuFRoeDoJO7wthSLq42EjA==" + }, + "simple-swizzle": { + "version": "0.2.2", + "resolved": "https://registry.npmjs.org/simple-swizzle/-/simple-swizzle-0.2.2.tgz", + "integrity": "sha1-pNprY1/8zMoz9w0Xy5JZLeleVXo=", + "requires": { + "is-arrayish": "^0.3.1" + }, + "dependencies": { + "is-arrayish": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/is-arrayish/-/is-arrayish-0.3.2.tgz", + "integrity": "sha512-eVRqCvVlZbuw3GrM63ovNSNAeA1K16kaR/LRY/92w0zxQ5/1YzwblUX652i4Xs9RwAGjW9d9y6X88t8OaAJfWQ==" + } + } + }, + "snapdragon": { + "version": "0.8.2", + "resolved": "https://registry.npmjs.org/snapdragon/-/snapdragon-0.8.2.tgz", + "integrity": "sha512-FtyOnWN/wCHTVXOMwvSv26d+ko5vWlIDD6zoUJ7LW8vh+ZBC8QdljveRP+crNrtBwioEUWy/4dMtbBjA4ioNlg==", + "requires": { + "base": "^0.11.1", + "debug": "^2.2.0", + "define-property": "^0.2.5", + "extend-shallow": "^2.0.1", + "map-cache": "^0.2.2", + "source-map": "^0.5.6", + "source-map-resolve": "^0.5.0", + "use": "^3.1.0" + }, + "dependencies": { + "debug": { + "version": "2.6.9", + "resolved": "https://registry.npmjs.org/debug/-/debug-2.6.9.tgz", + "integrity": "sha512-bC7ElrdJaJnPbAP+1EotYvqZsb3ecl5wi6Bfi6BJTUcNowp6cvspg0jXznRTKDjm/E7AdgFBVeAPVMNcKGsHMA==", + "requires": { + "ms": "2.0.0" + } + }, + "define-property": { + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-0.2.5.tgz", + "integrity": "sha1-w1se+RjsPJkPmlvFe+BKrOxcgRY=", + "requires": { + "is-descriptor": "^0.1.0" + } + }, + "extend-shallow": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/extend-shallow/-/extend-shallow-2.0.1.tgz", + "integrity": "sha1-Ua99YUrZqfYQ6huvu5idaxxWiQ8=", + "requires": { + "is-extendable": "^0.1.0" + } + }, + "ms": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/ms/-/ms-2.0.0.tgz", + "integrity": "sha1-VgiurfwAvmwpAd9fmGF4jeDVl8g=" + }, + "source-map": { + "version": "0.5.7", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz", + "integrity": "sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=" + } + } + }, + "snapdragon-node": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/snapdragon-node/-/snapdragon-node-2.1.1.tgz", + "integrity": "sha512-O27l4xaMYt/RSQ5TR3vpWCAB5Kb/czIcqUFOM/C4fYcLnbZUc1PkjTAMjof2pBWaSTwOUd6qUHcFGVGj7aIwnw==", + "requires": { + "define-property": "^1.0.0", + "isobject": "^3.0.0", + "snapdragon-util": "^3.0.1" + }, + "dependencies": { + "define-property": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-1.0.0.tgz", + "integrity": "sha1-dp66rz9KY6rTr56NMEybvnm/sOY=", + "requires": { + "is-descriptor": "^1.0.0" + } + }, + "is-accessor-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-accessor-descriptor/-/is-accessor-descriptor-1.0.0.tgz", + "integrity": "sha512-m5hnHTkcVsPfqx3AKlyttIPb7J+XykHvJP2B9bZDjlhLIoEq4XoK64Vg7boZlVWYK6LUY94dYPEE7Lh0ZkZKcQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-data-descriptor": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/is-data-descriptor/-/is-data-descriptor-1.0.0.tgz", + "integrity": "sha512-jbRXy1FmtAoCjQkVmIVYwuuqDFUbaOeDjmed1tOGPrsMhtJA4rD9tkgA0F1qJ3gRFRXcHYVkdeaP50Q5rE/jLQ==", + "requires": { + "kind-of": "^6.0.0" + } + }, + "is-descriptor": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/is-descriptor/-/is-descriptor-1.0.2.tgz", + "integrity": "sha512-2eis5WqQGV7peooDyLmNEPUrps9+SXX5c9pL3xEB+4e9HnGuDa7mB7kHxHw4CbqS9k1T2hOH3miL8n8WtiYVtg==", + "requires": { + "is-accessor-descriptor": "^1.0.0", + "is-data-descriptor": "^1.0.0", + "kind-of": "^6.0.2" + } + } + } + }, + "snapdragon-util": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/snapdragon-util/-/snapdragon-util-3.0.1.tgz", + "integrity": "sha512-mbKkMdQKsjX4BAL4bRYTj21edOf8cN7XHdYUJEe+Zn99hVEYcMvKPct1IqNe7+AZPirn8BCDOQBHQZknqmKlZQ==", + "requires": { + "kind-of": "^3.2.0" + }, + "dependencies": { + "kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "sockjs": { + "version": "0.3.21", + "resolved": "https://registry.npmjs.org/sockjs/-/sockjs-0.3.21.tgz", + "integrity": "sha512-DhbPFGpxjc6Z3I+uX07Id5ZO2XwYsWOrYjaSeieES78cq+JaJvVe5q/m1uvjIQhXinhIeCFRH6JgXe+mvVMyXw==", + "requires": { + "faye-websocket": "^0.11.3", + "uuid": "^3.4.0", + "websocket-driver": "^0.7.4" + } + }, + "sockjs-client": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/sockjs-client/-/sockjs-client-1.5.1.tgz", + "integrity": "sha512-VnVAb663fosipI/m6pqRXakEOw7nvd7TUgdr3PlR/8V2I95QIdwT8L4nMxhyU8SmDBHYXU1TOElaKOmKLfYzeQ==", + "requires": { + "debug": "^3.2.6", + "eventsource": "^1.0.7", + "faye-websocket": "^0.11.3", + "inherits": "^2.0.4", + "json3": "^3.3.3", + "url-parse": "^1.5.1" + }, + "dependencies": { + "debug": { + "version": "3.2.7", + "resolved": "https://registry.npmjs.org/debug/-/debug-3.2.7.tgz", + "integrity": "sha512-CFjzYYAi4ThfiQvizrFQevTTXHtnCqWfe7x1AhgEscTz6ZbLbfoLRLPugTQyBth6f8ZERVUSyWHFD/7Wu4t1XQ==", + "requires": { + "ms": "^2.1.1" + } + } + } + }, + "source-list-map": { + "version": "2.0.1", + "resolved": "https://registry.npmjs.org/source-list-map/-/source-list-map-2.0.1.tgz", + "integrity": "sha512-qnQ7gVMxGNxsiL4lEuJwe/To8UnK7fAnmbGEEH8RpLouuKbeEm0lhbQVFIrNSuB+G7tVrAlVsZgETT5nljf+Iw==" + }, + "source-map": { + "version": "0.6.1", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.6.1.tgz", + "integrity": "sha512-UjgapumWlbMhkBgzT7Ykc5YXUT46F0iKu8SGXq0bcwP5dz/h0Plj6enJqjz1Zbq2l5WaqYnrVbwWOWMyF3F47g==" + }, + "source-map-resolve": { + "version": "0.5.3", + "resolved": "https://registry.npmjs.org/source-map-resolve/-/source-map-resolve-0.5.3.tgz", + "integrity": "sha512-Htz+RnsXWk5+P2slx5Jh3Q66vhQj1Cllm0zvnaY98+NFx+Dv2CF/f5O/t8x+KaNdrdIAsruNzoh/KpialbqAnw==", + "requires": { + "atob": "^2.1.2", + "decode-uri-component": "^0.2.0", + "resolve-url": "^0.2.1", + "source-map-url": "^0.4.0", + "urix": "^0.1.0" + } + }, + "source-map-support": { + "version": "0.5.19", + "resolved": "https://registry.npmjs.org/source-map-support/-/source-map-support-0.5.19.tgz", + "integrity": "sha512-Wonm7zOCIJzBGQdB+thsPar0kYuCIzYvxZwlBa87yi/Mdjv7Tip2cyVbLj5o0cFPN4EVkuTwb3GDDyUx2DGnGw==", + "requires": { + "buffer-from": "^1.0.0", + "source-map": "^0.6.0" + } + }, + "source-map-url": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/source-map-url/-/source-map-url-0.4.1.tgz", + "integrity": "sha512-cPiFOTLUKvJFIg4SKVScy4ilPPW6rFgMgfuZJPNoDuMs3nC1HbMUycBoJw77xFIp6z1UJQJOfx6C9GMH80DiTw==" + }, + "spago": { + "version": "0.19.2", + "resolved": "https://registry.npmjs.org/spago/-/spago-0.19.2.tgz", + "integrity": "sha512-/u4ofPqWkK1JKRlDU8ZpuLVEOqOpD7/F9zIms4jaPxrXDNhddvhZkbYXrFF/Pe4ZpawysrkhQxhKKt+FJfOfuw==", + "requires": { + "request": "^2.88.0", + "tar": "^4.4.8" + } + }, + "spdy": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/spdy/-/spdy-4.0.2.tgz", + "integrity": "sha512-r46gZQZQV+Kl9oItvl1JZZqJKGr+oEkB08A6BzkiR7593/7IbtuncXHd2YoYeTsG4157ZssMu9KYvUHLcjcDoA==", + "requires": { + "debug": "^4.1.0", + "handle-thing": "^2.0.0", + "http-deceiver": "^1.2.7", + "select-hose": "^2.0.0", + "spdy-transport": "^3.0.0" + } + }, + "spdy-transport": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/spdy-transport/-/spdy-transport-3.0.0.tgz", + "integrity": "sha512-hsLVFE5SjA6TCisWeJXFKniGGOpBgMLmerfO2aCyCU5s7nJ/rpAepqmFifv/GCbSbueEeAJJnmSQ2rKC/g8Fcw==", + "requires": { + "debug": "^4.1.0", + "detect-node": "^2.0.4", + "hpack.js": "^2.1.6", + "obuf": "^1.1.2", + "readable-stream": "^3.0.6", + "wbuf": "^1.7.3" + }, + "dependencies": { + "readable-stream": { + "version": "3.6.0", + "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-3.6.0.tgz", + "integrity": "sha512-BViHy7LKeTz4oNnkcLJ+lVSL6vpiFeX6/d3oSH8zCW7UxP2onchk+vTGB143xuFjHS3deTgkKoXXymXqymiIdA==", + "requires": { + "inherits": "^2.0.3", + "string_decoder": "^1.1.1", + "util-deprecate": "^1.0.1" + } + } + } + }, + "split-string": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/split-string/-/split-string-3.1.0.tgz", + "integrity": "sha512-NzNVhJDYpwceVVii8/Hu6DKfD2G+NrQHlS/V/qgv763EYudVwEcMQNxd2lh+0VrUByXN/oJkl5grOhYWvQUYiw==", + "requires": { + "extend-shallow": "^3.0.0" + } + }, + "sprintf-js": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/sprintf-js/-/sprintf-js-1.0.3.tgz", + "integrity": "sha1-BOaSb2YolTVPPdAVIDYzuFcpfiw=" + }, + "srcset": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/srcset/-/srcset-3.0.1.tgz", + "integrity": "sha512-MM8wDGg5BQJEj94tDrZDrX9wrC439/Eoeg3sgmVLPMjHgrAFeXAKk3tmFlCbKw5k+yOEhPXRpPlRcisQmqWVSQ==" + }, + "sshpk": { + "version": "1.16.1", + "resolved": "https://registry.npmjs.org/sshpk/-/sshpk-1.16.1.tgz", + "integrity": "sha512-HXXqVUq7+pcKeLqqZj6mHFUMvXtOJt1uoUx09pFW6011inTMxqI8BA8PM95myrIyyKwdnzjdFjLiE6KBPVtJIg==", + "requires": { + "asn1": "~0.2.3", + "assert-plus": "^1.0.0", + "bcrypt-pbkdf": "^1.0.0", + "dashdash": "^1.12.0", + "ecc-jsbn": "~0.1.1", + "getpass": "^0.1.1", + "jsbn": "~0.1.0", + "safer-buffer": "^2.0.2", + "tweetnacl": "~0.14.0" + } + }, + "ssri": { + "version": "6.0.2", + "resolved": "https://registry.npmjs.org/ssri/-/ssri-6.0.2.tgz", + "integrity": "sha512-cepbSq/neFK7xB6A50KHN0xHDotYzq58wWCa5LeWqnPrHG8GzfEjO/4O8kpmcGW+oaxkvhEJCWgbgNk4/ZV93Q==", + "requires": { + "figgy-pudding": "^3.5.1" + } + }, + "stable": { + "version": "0.1.8", + "resolved": "https://registry.npmjs.org/stable/-/stable-0.1.8.tgz", + "integrity": "sha512-ji9qxRnOVfcuLDySj9qzhGSEFVobyt1kIOSkj1qZzYLzq7Tos/oUUWvotUPQLlrsidqsK6tBH89Bc9kL5zHA6w==" + }, + "static-eval": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/static-eval/-/static-eval-2.1.0.tgz", + "integrity": "sha512-agtxZ/kWSsCkI5E4QifRwsaPs0P0JmZV6dkLz6ILYfFYQGn+5plctanRN+IC8dJRiFkyXHrwEE3W9Wmx67uDbw==", + "requires": { + "escodegen": "^1.11.1" + }, + "dependencies": { + "escodegen": { + "version": "1.14.3", + "resolved": "https://registry.npmjs.org/escodegen/-/escodegen-1.14.3.tgz", + "integrity": "sha512-qFcX0XJkdg+PB3xjZZG/wKSuT1PnQWx57+TVSjIMmILd2yC/6ByYElPwJnslDsuWuSAp4AwJGumarAAmJch5Kw==", + "requires": { + "esprima": "^4.0.1", + "estraverse": "^4.2.0", + "esutils": "^2.0.2", + "optionator": "^0.8.1", + "source-map": "~0.6.1" + } + }, + "esprima": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/esprima/-/esprima-4.0.1.tgz", + "integrity": "sha512-eGuFFw7Upda+g4p+QHvnW0RyTX/SVeJBDM/gCtMARO0cLuT2HcEKnTPvhjV6aGeqrCB/sbNop0Kszm0jsaWU4A==" + } + } + }, + "static-extend": { + "version": "0.1.2", + "resolved": "https://registry.npmjs.org/static-extend/-/static-extend-0.1.2.tgz", + "integrity": "sha1-YICcOcv/VTNyJv1eC1IPNB8ftcY=", + "requires": { + "define-property": "^0.2.5", + "object-copy": "^0.1.0" + }, + "dependencies": { + "define-property": { + "version": "0.2.5", + "resolved": "https://registry.npmjs.org/define-property/-/define-property-0.2.5.tgz", + "integrity": "sha1-w1se+RjsPJkPmlvFe+BKrOxcgRY=", + "requires": { + "is-descriptor": "^0.1.0" + } + } + } + }, + "static-module": { + "version": "2.2.5", + "resolved": "https://registry.npmjs.org/static-module/-/static-module-2.2.5.tgz", + "integrity": "sha512-D8vv82E/Kpmz3TXHKG8PPsCPg+RAX6cbCOyvjM6x04qZtQ47EtJFVwRsdov3n5d6/6ynrOY9XB4JkaZwB2xoRQ==", + "requires": { + "concat-stream": "~1.6.0", + "convert-source-map": "^1.5.1", + "duplexer2": "~0.1.4", + "escodegen": "~1.9.0", + "falafel": "^2.1.0", + "has": "^1.0.1", + "magic-string": "^0.22.4", + "merge-source-map": "1.0.4", + "object-inspect": "~1.4.0", + "quote-stream": "~1.0.2", + "readable-stream": "~2.3.3", + "shallow-copy": "~0.0.1", + "static-eval": "^2.0.0", + "through2": "~2.0.3" + } + }, + "statuses": { + "version": "1.5.0", + "resolved": "https://registry.npmjs.org/statuses/-/statuses-1.5.0.tgz", + "integrity": "sha1-Fhx9rBd2Wf2YEfQ3cfqZOBR4Yow=" + }, + "stealthy-require": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/stealthy-require/-/stealthy-require-1.1.1.tgz", + "integrity": "sha1-NbCYdbT/SfJqd35QmzCQoyJr8ks=" + }, + "stream-browserify": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/stream-browserify/-/stream-browserify-2.0.2.tgz", + "integrity": "sha512-nX6hmklHs/gr2FuxYDltq8fJA1GDlxKQCz8O/IM4atRqBH8OORmBNgfvW5gG10GT/qQ9u0CzIvr2X5Pkt6ntqg==", + "requires": { + "inherits": "~2.0.1", + "readable-stream": "^2.0.2" + } + }, + "stream-each": { + "version": "1.2.3", + "resolved": "https://registry.npmjs.org/stream-each/-/stream-each-1.2.3.tgz", + "integrity": "sha512-vlMC2f8I2u/bZGqkdfLQW/13Zihpej/7PmSiMQsbYddxuTsJp8vRe2x2FvVExZg7FaOds43ROAuFJwPR4MTZLw==", + "requires": { + "end-of-stream": "^1.1.0", + "stream-shift": "^1.0.0" + } + }, + "stream-http": { + "version": "2.8.3", + "resolved": "https://registry.npmjs.org/stream-http/-/stream-http-2.8.3.tgz", + "integrity": "sha512-+TSkfINHDo4J+ZobQLWiMouQYB+UVYFttRA94FpEzzJ7ZdqcL4uUUQ7WkdkI4DSozGmgBUE/a47L+38PenXhUw==", + "requires": { + "builtin-status-codes": "^3.0.0", + "inherits": "^2.0.1", + "readable-stream": "^2.3.6", + "to-arraybuffer": "^1.0.0", + "xtend": "^4.0.0" + } + }, + "stream-shift": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/stream-shift/-/stream-shift-1.0.1.tgz", + "integrity": "sha512-AiisoFqQ0vbGcZgQPY1cdP2I76glaVA/RauYR4G4thNFgkTqr90yXTo4LYX60Jl+sIlPNHHdGSwo01AvbKUSVQ==" + }, + "string-width": { + "version": "3.1.0", + "resolved": "https://registry.npmjs.org/string-width/-/string-width-3.1.0.tgz", + "integrity": "sha512-vafcv6KjVZKSgz06oM/H6GDBrAtz8vdhQakGjFIvNrHA6y3HCF1CInLy+QLq8dTJPQ1b+KDUqDFctkdRW44e1w==", + "requires": { + "emoji-regex": "^7.0.1", + "is-fullwidth-code-point": "^2.0.0", + "strip-ansi": "^5.1.0" + }, + "dependencies": { + "ansi-regex": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-4.1.0.tgz", + "integrity": "sha512-1apePfXM1UOSqw0o9IiFAovVz9M5S1Dg+4TrDwfMewQ6p/rmMueb7tWZjQ1rx4Loy1ArBggoqGpfqqdI4rondg==" + }, + "strip-ansi": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-5.2.0.tgz", + "integrity": "sha512-DuRs1gKbBqsMKIZlrffwlug8MHkcnpjs5VPmL1PAh+mA30U0DTotfDZ0d2UUsXpPmPmMMJ6W773MaA3J+lbiWA==", + "requires": { + "ansi-regex": "^4.1.0" + } + } + } + }, + "string.prototype.trimend": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/string.prototype.trimend/-/string.prototype.trimend-1.0.4.tgz", + "integrity": "sha512-y9xCjw1P23Awk8EvTpcyL2NIr1j7wJ39f+k6lvRnSMz+mz9CGz9NYPelDk42kOz6+ql8xjfK8oYzy3jAP5QU5A==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3" + } + }, + "string.prototype.trimstart": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/string.prototype.trimstart/-/string.prototype.trimstart-1.0.4.tgz", + "integrity": "sha512-jh6e984OBfvxS50tdY2nRZnoC5/mLFKOREQfw8t5yytkoUsJRNxvI/E39qu1sD0OtWI3OC0XgKSmcWwziwYuZw==", + "requires": { + "call-bind": "^1.0.2", + "define-properties": "^1.1.3" + } + }, + "string_decoder": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/string_decoder/-/string_decoder-1.1.1.tgz", + "integrity": "sha512-n/ShnvDi6FHbbVfviro+WojiFzv+s8MPMHBczVePfUpDJLwoLT0ht1l4YwBCbi8pJAveEEdnkHyPyTP/mzRfwg==", + "requires": { + "safe-buffer": "~5.1.0" + } + }, + "strip-ansi": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-4.0.0.tgz", + "integrity": "sha1-qEeQIusaw2iocTibY1JixQXuNo8=", + "requires": { + "ansi-regex": "^3.0.0" + } + }, + "strip-eof": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/strip-eof/-/strip-eof-1.0.0.tgz", + "integrity": "sha1-u0P/VZim6wXYm1n80SnJgzE2Br8=" + }, + "strip-final-newline": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/strip-final-newline/-/strip-final-newline-2.0.0.tgz", + "integrity": "sha512-BrpvfNAE3dcvq7ll3xVumzjKjZQ5tI1sEUIKr3Uoks0XUl45St3FlatVqef9prk4jRDzhW6WZg+3bk93y6pLjA==" + }, + "stylehacks": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/stylehacks/-/stylehacks-4.0.3.tgz", + "integrity": "sha512-7GlLk9JwlElY4Y6a/rmbH2MhVlTyVmiJd1PfTCqFaIBEGMYNsrO/v3SeGTdhBThLg4Z+NbOk/qFMwCa+J+3p/g==", + "requires": { + "browserslist": "^4.0.0", + "postcss": "^7.0.0", + "postcss-selector-parser": "^3.0.0" + }, + "dependencies": { + "postcss-selector-parser": { + "version": "3.1.2", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-3.1.2.tgz", + "integrity": "sha512-h7fJ/5uWuRVyOtkO45pnt1Ih40CEleeyCHzipqAZO2e5H20g25Y48uYnFUiShvY4rZWNJ/Bib/KVPmanaCtOhA==", + "requires": { + "dot-prop": "^5.2.0", + "indexes-of": "^1.0.1", + "uniq": "^1.0.1" + } + } + } + }, + "supports-color": { + "version": "5.5.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-5.5.0.tgz", + "integrity": "sha512-QjVjwdXIt408MIiAqCX4oUKsgU2EqAGzs2Ppkm4aQYbjm+ZEWEcW4SfFNTr4uMNZma0ey4f5lgLrkB0aX0QMow==", + "requires": { + "has-flag": "^3.0.0" + } + }, + "svgo": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/svgo/-/svgo-1.3.2.tgz", + "integrity": "sha512-yhy/sQYxR5BkC98CY7o31VGsg014AKLEPxdfhora76l36hD9Rdy5NZA/Ocn6yayNPgSamYdtX2rFJdcv07AYVw==", + "requires": { + "chalk": "^2.4.1", + "coa": "^2.0.2", + "css-select": "^2.0.0", + "css-select-base-adapter": "^0.1.1", + "css-tree": "1.0.0-alpha.37", + "csso": "^4.0.2", + "js-yaml": "^3.13.1", + "mkdirp": "~0.5.1", + "object.values": "^1.1.0", + "sax": "~1.2.4", + "stable": "^0.1.8", + "unquote": "~1.1.1", + "util.promisify": "~1.0.0" + } + }, + "symbol-tree": { + "version": "3.2.4", + "resolved": "https://registry.npmjs.org/symbol-tree/-/symbol-tree-3.2.4.tgz", + "integrity": "sha512-9QNk5KwDF+Bvz+PyObkmSYjI5ksVUYtjW7AU22r2NKcfLJcXp96hkDWU3+XndOsUb+AQ9QhfzfCT2O+CNWT5Tw==" + }, + "tapable": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/tapable/-/tapable-2.2.0.tgz", + "integrity": "sha512-FBk4IesMV1rBxX2tfiK8RAmogtWn53puLOQlvO8XuwlgxcYbP4mVPS9Ph4aeamSyyVjOl24aYWAuc8U5kCVwMw==" + }, + "tar": { + "version": "4.4.13", + "resolved": "https://registry.npmjs.org/tar/-/tar-4.4.13.tgz", + "integrity": "sha512-w2VwSrBoHa5BsSyH+KxEqeQBAllHhccyMFVHtGtdMpF4W7IRWfZjFiQceJPChOeTsSDVUpER2T8FA93pr0L+QA==", + "requires": { + "chownr": "^1.1.1", + "fs-minipass": "^1.2.5", + "minipass": "^2.8.6", + "minizlib": "^1.2.1", + "mkdirp": "^0.5.0", + "safe-buffer": "^5.1.2", + "yallist": "^3.0.3" + }, + "dependencies": { + "yallist": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/yallist/-/yallist-3.1.1.tgz", + "integrity": "sha512-a4UGQaWPH59mOXUYnAG2ewncQS4i4F43Tv3JoAM+s2VDAmS9NsK8GpDMLrCHPksFT7h3K6TOoUNn2pb7RoXx4g==" + } + } + }, + "terser": { + "version": "3.17.0", + "resolved": "https://registry.npmjs.org/terser/-/terser-3.17.0.tgz", + "integrity": "sha512-/FQzzPJmCpjAH9Xvk2paiWrFq+5M6aVOf+2KRbwhByISDX/EujxsK+BAvrhb6H+2rtrLCHK9N01wO014vrIwVQ==", + "requires": { + "commander": "^2.19.0", + "source-map": "~0.6.1", + "source-map-support": "~0.5.10" + } + }, + "terser-webpack-plugin": { + "version": "5.1.4", + "resolved": "https://registry.npmjs.org/terser-webpack-plugin/-/terser-webpack-plugin-5.1.4.tgz", + "integrity": "sha512-C2WkFwstHDhVEmsmlCxrXUtVklS+Ir1A7twrYzrDrQQOIMOaVAYykaoo/Aq1K0QRkMoY2hhvDQY1cm4jnIMFwA==", + "requires": { + "jest-worker": "^27.0.2", + "p-limit": "^3.1.0", + "schema-utils": "^3.0.0", + "serialize-javascript": "^6.0.0", + "source-map": "^0.6.1", + "terser": "^5.7.0" + }, + "dependencies": { + "terser": { + "version": "5.7.0", + "resolved": "https://registry.npmjs.org/terser/-/terser-5.7.0.tgz", + "integrity": "sha512-HP5/9hp2UaZt5fYkuhNBR8YyRcT8juw8+uFbAme53iN9hblvKnLUTKkmwJG6ocWpIKf8UK4DoeWG4ty0J6S6/g==", + "requires": { + "commander": "^2.20.0", + "source-map": "~0.7.2", + "source-map-support": "~0.5.19" + }, + "dependencies": { + "source-map": { + "version": "0.7.3", + "resolved": "https://registry.npmjs.org/source-map/-/source-map-0.7.3.tgz", + "integrity": "sha512-CkCj6giN3S+n9qrYiBTX5gystlENnRW5jZeNLHpe6aue+SrHcG5VYwujhW9s4dY31mEGsxBDrHR6oI69fTXsaQ==" + } + } + } + } + }, + "through2": { + "version": "2.0.5", + "resolved": "https://registry.npmjs.org/through2/-/through2-2.0.5.tgz", + "integrity": "sha512-/mrRod8xqpA+IHSLyGCQ2s8SPHiCDEeQJSep1jqLYeEUClOFG2Qsh+4FU6G9VeqpZnGW/Su8LQGc4YKni5rYSQ==", + "requires": { + "readable-stream": "~2.3.6", + "xtend": "~4.0.1" + } + }, + "thunky": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/thunky/-/thunky-1.1.0.tgz", + "integrity": "sha512-eHY7nBftgThBqOyHGVN+l8gF0BucP09fMo0oO/Lb0w1OF80dJv+lDVpXG60WMQvkcxAkNybKsrEIE3ZtKGmPrA==" + }, + "timers-browserify": { + "version": "2.0.12", + "resolved": "https://registry.npmjs.org/timers-browserify/-/timers-browserify-2.0.12.tgz", + "integrity": "sha512-9phl76Cqm6FhSX9Xe1ZUAMLtm1BLkKj2Qd5ApyWkXzsMRaA7dgr81kf4wJmQf/hAvg8EEyJxDo3du/0KlhPiKQ==", + "requires": { + "setimmediate": "^1.0.4" + } + }, + "timsort": { + "version": "0.3.0", + "resolved": "https://registry.npmjs.org/timsort/-/timsort-0.3.0.tgz", + "integrity": "sha1-QFQRqOfmM5/mTbmiNN4R3DHgK9Q=" + }, + "tiny-inflate": { + "version": "1.0.3", + "resolved": "https://registry.npmjs.org/tiny-inflate/-/tiny-inflate-1.0.3.tgz", + "integrity": "sha512-pkY1fj1cKHb2seWDy0B16HeWyczlJA9/WW3u3c4z/NiWDsO3DOU5D7nhTLE9CF0yXv/QZFY7sEJmj24dK+Rrqw==" + }, + "to-arraybuffer": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/to-arraybuffer/-/to-arraybuffer-1.0.1.tgz", + "integrity": "sha1-fSKbH8xjfkZsoIEYCDanqr/4P0M=" + }, + "to-fast-properties": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/to-fast-properties/-/to-fast-properties-2.0.0.tgz", + "integrity": "sha1-3F5pjL0HkmW8c+A3doGk5Og/YW4=" + }, + "to-object-path": { + "version": "0.3.0", + "resolved": "https://registry.npmjs.org/to-object-path/-/to-object-path-0.3.0.tgz", + "integrity": "sha1-KXWIt7Dn4KwI4E5nL4XB9JmeF68=", + "requires": { + "kind-of": "^3.0.2" + }, + "dependencies": { + "kind-of": { + "version": "3.2.2", + "resolved": "https://registry.npmjs.org/kind-of/-/kind-of-3.2.2.tgz", + "integrity": "sha1-MeohpzS6ubuw8yRm2JOupR5KPGQ=", + "requires": { + "is-buffer": "^1.1.5" + } + } + } + }, + "to-regex": { + "version": "3.0.2", + "resolved": "https://registry.npmjs.org/to-regex/-/to-regex-3.0.2.tgz", + "integrity": "sha512-FWtleNAtZ/Ki2qtqej2CXTOayOH9bHDQF+Q48VpWyDXjbYxA4Yz8iDB31zXOBUlOHHKidDbqGVrTUvQMPmBGBw==", + "requires": { + "define-property": "^2.0.2", + "extend-shallow": "^3.0.2", + "regex-not": "^1.0.2", + "safe-regex": "^1.1.0" + } + }, + "to-regex-range": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/to-regex-range/-/to-regex-range-2.1.1.tgz", + "integrity": "sha1-fIDBe53+vlmeJzZ+DU3VWQFB2zg=", + "requires": { + "is-number": "^3.0.0", + "repeat-string": "^1.6.1" + } + }, + "toidentifier": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/toidentifier/-/toidentifier-1.0.0.tgz", + "integrity": "sha512-yaOH/Pk/VEhBWWTlhI+qXxDFXlejDGcQipMlyxda9nthulaxLZUNcUqFxokp0vcYnvteJln5FNQDRrxj3YcbVw==" + }, + "tough-cookie": { + "version": "2.5.0", + "resolved": "https://registry.npmjs.org/tough-cookie/-/tough-cookie-2.5.0.tgz", + "integrity": "sha512-nlLsUzgm1kfLXSXfRZMc1KLAugd4hqJHDTvc2hDIwS3mZAfMEuMbc03SujMF+GEcpaX/qboeycw6iO8JwVv2+g==", + "requires": { + "psl": "^1.1.28", + "punycode": "^2.1.1" + } + }, + "tr46": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/tr46/-/tr46-1.0.1.tgz", + "integrity": "sha1-qLE/1r/SSJUZZ0zN5VujaTtwbQk=", + "requires": { + "punycode": "^2.1.0" + } + }, + "trim-right": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/trim-right/-/trim-right-1.0.1.tgz", + "integrity": "sha1-yy4SAwZ+DI3h9hQJS5/kVwTqYAM=" + }, + "tslib": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/tslib/-/tslib-2.3.0.tgz", + "integrity": "sha512-N82ooyxVNm6h1riLCoyS9e3fuJ3AMG2zIZs2Gd1ATcSFjSA23Q0fzjjZeh0jbJvWVDZ0cJT8yaNNaaXHzueNjg==" + }, + "tty-browserify": { + "version": "0.0.0", + "resolved": "https://registry.npmjs.org/tty-browserify/-/tty-browserify-0.0.0.tgz", + "integrity": "sha1-oVe6QC2iTpv5V/mqadUk7tQpAaY=" + }, + "tunnel-agent": { + "version": "0.6.0", + "resolved": "https://registry.npmjs.org/tunnel-agent/-/tunnel-agent-0.6.0.tgz", + "integrity": "sha1-J6XeoGs2sEoKmWZ3SykIaPD8QP0=", + "requires": { + "safe-buffer": "^5.0.1" + } + }, + "tweetnacl": { + "version": "0.14.5", + "resolved": "https://registry.npmjs.org/tweetnacl/-/tweetnacl-0.14.5.tgz", + "integrity": "sha1-WuaBd/GS1EViadEIr6k/+HQ/T2Q=" + }, + "type-check": { + "version": "0.3.2", + "resolved": "https://registry.npmjs.org/type-check/-/type-check-0.3.2.tgz", + "integrity": "sha1-WITKtRLPHTVeP7eE8wgEsrUg23I=", + "requires": { + "prelude-ls": "~1.1.2" + } + }, + "type-is": { + "version": "1.6.18", + "resolved": "https://registry.npmjs.org/type-is/-/type-is-1.6.18.tgz", + "integrity": "sha512-TkRKr9sUTxEH8MdfuCSP7VizJyzRNMjj2J2do2Jr3Kym598JVdEksuzPQCnlFPW4ky9Q+iA+ma9BGm06XQBy8g==", + "requires": { + "media-typer": "0.3.0", + "mime-types": "~2.1.24" + } + }, + "typedarray": { + "version": "0.0.6", + "resolved": "https://registry.npmjs.org/typedarray/-/typedarray-0.0.6.tgz", + "integrity": "sha1-hnrHTjhkGHsdPUfZlqeOxciDB3c=" + }, + "unbox-primitive": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/unbox-primitive/-/unbox-primitive-1.0.1.tgz", + "integrity": "sha512-tZU/3NqK3dA5gpE1KtyiJUrEB0lxnGkMFHptJ7q6ewdZ8s12QrODwNbhIJStmJkd1QDXa1NRA8aF2A1zk/Ypyw==", + "requires": { + "function-bind": "^1.1.1", + "has-bigints": "^1.0.1", + "has-symbols": "^1.0.2", + "which-boxed-primitive": "^1.0.2" + } + }, + "uncss": { + "version": "0.17.3", + "resolved": "https://registry.npmjs.org/uncss/-/uncss-0.17.3.tgz", + "integrity": "sha512-ksdDWl81YWvF/X14fOSw4iu8tESDHFIeyKIeDrK6GEVTQvqJc1WlOEXqostNwOCi3qAj++4EaLsdAgPmUbEyog==", + "requires": { + "commander": "^2.20.0", + "glob": "^7.1.4", + "is-absolute-url": "^3.0.1", + "is-html": "^1.1.0", + "jsdom": "^14.1.0", + "lodash": "^4.17.15", + "postcss": "^7.0.17", + "postcss-selector-parser": "6.0.2", + "request": "^2.88.0" + }, + "dependencies": { + "is-absolute-url": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/is-absolute-url/-/is-absolute-url-3.0.3.tgz", + "integrity": "sha512-opmNIX7uFnS96NtPmhWQgQx6/NYFgsUXYMllcfzwWKUMwfo8kku1TvE6hkNcH+Q1ts5cMVrsY7j0bxXQDciu9Q==" + }, + "postcss-selector-parser": { + "version": "6.0.2", + "resolved": "https://registry.npmjs.org/postcss-selector-parser/-/postcss-selector-parser-6.0.2.tgz", + "integrity": "sha512-36P2QR59jDTOAiIkqEprfJDsoNrvwFei3eCqKd1Y0tUsBimsq39BLp7RD+JWny3WgB1zGhJX8XVePwm9k4wdBg==", + "requires": { + "cssesc": "^3.0.0", + "indexes-of": "^1.0.1", + "uniq": "^1.0.1" + } + } + } + }, + "unicode-canonical-property-names-ecmascript": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/unicode-canonical-property-names-ecmascript/-/unicode-canonical-property-names-ecmascript-1.0.4.tgz", + "integrity": "sha512-jDrNnXWHd4oHiTZnx/ZG7gtUTVp+gCcTTKr8L0HjlwphROEW3+Him+IpvC+xcJEFegapiMZyZe02CyuOnRmbnQ==" + }, + "unicode-match-property-ecmascript": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/unicode-match-property-ecmascript/-/unicode-match-property-ecmascript-1.0.4.tgz", + "integrity": "sha512-L4Qoh15vTfntsn4P1zqnHulG0LdXgjSO035fEpdtp6YxXhMT51Q6vgM5lYdG/5X3MjS+k/Y9Xw4SFCY9IkR0rg==", + "requires": { + "unicode-canonical-property-names-ecmascript": "^1.0.4", + "unicode-property-aliases-ecmascript": "^1.0.4" + } + }, + "unicode-match-property-value-ecmascript": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/unicode-match-property-value-ecmascript/-/unicode-match-property-value-ecmascript-1.2.0.tgz", + "integrity": "sha512-wjuQHGQVofmSJv1uVISKLE5zO2rNGzM/KCYZch/QQvez7C1hUhBIuZ701fYXExuufJFMPhv2SyL8CyoIfMLbIQ==" + }, + "unicode-property-aliases-ecmascript": { + "version": "1.1.0", + "resolved": "https://registry.npmjs.org/unicode-property-aliases-ecmascript/-/unicode-property-aliases-ecmascript-1.1.0.tgz", + "integrity": "sha512-PqSoPh/pWetQ2phoj5RLiaqIk4kCNwoV3CI+LfGmWLKI3rE3kl1h59XpX2BjgDrmbxD9ARtQobPGU1SguCYuQg==" + }, + "unicode-trie": { + "version": "0.3.1", + "resolved": "https://registry.npmjs.org/unicode-trie/-/unicode-trie-0.3.1.tgz", + "integrity": "sha1-1nHd3YkQGgi6w3tqUWEBBgIFIIU=", + "requires": { + "pako": "^0.2.5", + "tiny-inflate": "^1.0.0" + } + }, + "union-value": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/union-value/-/union-value-1.0.1.tgz", + "integrity": "sha512-tJfXmxMeWYnczCVs7XAEvIV7ieppALdyepWMkHkwciRpZraG/xwT+s2JN8+pr1+8jCRf80FFzvr+MpQeeoF4Xg==", + "requires": { + "arr-union": "^3.1.0", + "get-value": "^2.0.6", + "is-extendable": "^0.1.1", + "set-value": "^2.0.1" + } + }, + "uniq": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/uniq/-/uniq-1.0.1.tgz", + "integrity": "sha1-sxxa6CVIRKOoKBVBzisEuGWnNP8=" + }, + "uniqs": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/uniqs/-/uniqs-2.0.0.tgz", + "integrity": "sha1-/+3ks2slKQaW5uFl1KWe25mOawI=" + }, + "unique-filename": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/unique-filename/-/unique-filename-1.1.1.tgz", + "integrity": "sha512-Vmp0jIp2ln35UTXuryvjzkjGdRyf9b2lTXuSYUiPmzRcl3FDtYqAwOnTJkAngD9SWhnoJzDbTKwaOrZ+STtxNQ==", + "requires": { + "unique-slug": "^2.0.0" + } + }, + "unique-slug": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/unique-slug/-/unique-slug-2.0.2.tgz", + "integrity": "sha512-zoWr9ObaxALD3DOPfjPSqxt4fnZiWblxHIgeWqW8x7UqDzEtHEQLzji2cuJYQFCU6KmoJikOYAZlrTHHebjx2w==", + "requires": { + "imurmurhash": "^0.1.4" + } + }, + "unpipe": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/unpipe/-/unpipe-1.0.0.tgz", + "integrity": "sha1-sr9O6FFKrmFltIF4KdIbLvSZBOw=" + }, + "unquote": { + "version": "1.1.1", + "resolved": "https://registry.npmjs.org/unquote/-/unquote-1.1.1.tgz", + "integrity": "sha1-j97XMk7G6IoP+LkF58CYzcCG1UQ=" + }, + "unset-value": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/unset-value/-/unset-value-1.0.0.tgz", + "integrity": "sha1-g3aHP30jNRef+x5vw6jtDfyKtVk=", + "requires": { + "has-value": "^0.3.1", + "isobject": "^3.0.0" + }, + "dependencies": { + "has-value": { + "version": "0.3.1", + "resolved": "https://registry.npmjs.org/has-value/-/has-value-0.3.1.tgz", + "integrity": "sha1-ex9YutpiyoJ+wKIHgCVlSEWZXh8=", + "requires": { + "get-value": "^2.0.3", + "has-values": "^0.1.4", + "isobject": "^2.0.0" + }, + "dependencies": { + "isobject": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/isobject/-/isobject-2.1.0.tgz", + "integrity": "sha1-8GVWEJaj8dou9GJy+BXIQNh+DIk=", + "requires": { + "isarray": "1.0.0" + } + } + } + }, + "has-values": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/has-values/-/has-values-0.1.4.tgz", + "integrity": "sha1-bWHeldkd/Km5oCCJrThL/49it3E=" + } + } + }, + "upath": { + "version": "1.2.0", + "resolved": "https://registry.npmjs.org/upath/-/upath-1.2.0.tgz", + "integrity": "sha512-aZwGpamFO61g3OlfT7OQCHqhGnW43ieH9WZeP7QxN/G/jS4jfqUkZxoryvJgVPEcrl5NL/ggHsSmLMHuH64Lhg==" + }, + "uri-js": { + "version": "4.4.1", + "resolved": "https://registry.npmjs.org/uri-js/-/uri-js-4.4.1.tgz", + "integrity": "sha512-7rKUyy33Q1yc98pQ1DAmLtwX109F7TIfWlW1Ydo8Wl1ii1SeHieeh0HHfPeL2fMXK6z0s8ecKs9frCuLJvndBg==", + "requires": { + "punycode": "^2.1.0" + } + }, + "urix": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/urix/-/urix-0.1.0.tgz", + "integrity": "sha1-2pN/emLiH+wf0Y1Js1wpNQZ6bHI=" + }, + "url": { + "version": "0.11.0", + "resolved": "https://registry.npmjs.org/url/-/url-0.11.0.tgz", + "integrity": "sha1-ODjpfPxgUh63PFJajlW/3Z4uKPE=", + "requires": { + "punycode": "1.3.2", + "querystring": "0.2.0" + }, + "dependencies": { + "punycode": { + "version": "1.3.2", + "resolved": "https://registry.npmjs.org/punycode/-/punycode-1.3.2.tgz", + "integrity": "sha1-llOgNvt8HuQjQvIyXM7v6jkmxI0=" + } + } + }, + "url-parse": { + "version": "1.5.1", + "resolved": "https://registry.npmjs.org/url-parse/-/url-parse-1.5.1.tgz", + "integrity": "sha512-HOfCOUJt7iSYzEx/UqgtwKRMC6EU91NFhsCHMv9oM03VJcVo2Qrp8T8kI9D7amFf1cu+/3CEhgb3rF9zL7k85Q==", + "requires": { + "querystringify": "^2.1.1", + "requires-port": "^1.0.0" + }, + "dependencies": { + "requires-port": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/requires-port/-/requires-port-1.0.0.tgz", + "integrity": "sha1-kl0mAdOaxIXgkc8NpcbmlNw9yv8=" + } + } + }, + "use": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/use/-/use-3.1.1.tgz", + "integrity": "sha512-cwESVXlO3url9YWlFW/TA9cshCEhtu7IKJ/p5soJ/gGpj7vbvFrAY/eIioQ6Dw23KjZhYgiIo8HOs1nQ2vr/oQ==" + }, + "util": { + "version": "0.11.1", + "resolved": "https://registry.npmjs.org/util/-/util-0.11.1.tgz", + "integrity": "sha512-HShAsny+zS2TZfaXxD9tYj4HQGlBezXZMZuM/S5PKLLoZkShZiGk9o5CzukI1LVHZvjdvZ2Sj1aW/Ndn2NB/HQ==", + "requires": { + "inherits": "2.0.3" + }, + "dependencies": { + "inherits": { + "version": "2.0.3", + "resolved": "https://registry.npmjs.org/inherits/-/inherits-2.0.3.tgz", + "integrity": "sha1-Yzwsg+PaQqUC9SRmAiSA9CCCYd4=" + } + } + }, + "util-deprecate": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/util-deprecate/-/util-deprecate-1.0.2.tgz", + "integrity": "sha1-RQ1Nyfpw3nMnYvvS1KKJgUGaDM8=" + }, + "util.promisify": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/util.promisify/-/util.promisify-1.0.1.tgz", + "integrity": "sha512-g9JpC/3He3bm38zsLupWryXHoEcS22YHthuPQSJdMy6KNrzIRzWqcsHzD/WUnqe45whVou4VIsPew37DoXWNrA==", + "requires": { + "define-properties": "^1.1.3", + "es-abstract": "^1.17.2", + "has-symbols": "^1.0.1", + "object.getownpropertydescriptors": "^2.1.0" + } + }, + "utila": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/utila/-/utila-0.4.0.tgz", + "integrity": "sha1-ihagXURWV6Oupe7MWxKk+lN5dyw=" + }, + "utils-merge": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/utils-merge/-/utils-merge-1.0.1.tgz", + "integrity": "sha1-n5VxD1CiZ5R7LMwSR0HBAoQn5xM=" + }, + "uuid": { + "version": "3.4.0", + "resolved": "https://registry.npmjs.org/uuid/-/uuid-3.4.0.tgz", + "integrity": "sha512-HjSDRw6gZE5JMggctHBcjVak08+KEVhSIiDzFnT9S9aegmp85S/bReBVTb4QTFaRNptJ9kuYaNhnbNEOkbKb/A==" + }, + "v8-compile-cache": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/v8-compile-cache/-/v8-compile-cache-2.3.0.tgz", + "integrity": "sha512-l8lCEmLcLYZh4nbunNZvQCJc5pv7+RCwa8q/LdUx8u7lsWvPDKmpodJAJNwkAhJC//dFY48KuIEmjtd4RViDrA==" + }, + "vary": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/vary/-/vary-1.1.2.tgz", + "integrity": "sha1-IpnwLG3tMNSllhsLn3RSShj2NPw=" + }, + "vendors": { + "version": "1.0.4", + "resolved": "https://registry.npmjs.org/vendors/-/vendors-1.0.4.tgz", + "integrity": "sha512-/juG65kTL4Cy2su4P8HjtkTxk6VmJDiOPBufWniqQ6wknac6jNiXS9vU+hO3wgusiyqWlzTbVHi0dyJqRONg3w==" + }, + "verror": { + "version": "1.10.0", + "resolved": "https://registry.npmjs.org/verror/-/verror-1.10.0.tgz", + "integrity": "sha1-OhBcoXBTr1XW4nDB+CiGguGNpAA=", + "requires": { + "assert-plus": "^1.0.0", + "core-util-is": "1.0.2", + "extsprintf": "^1.2.0" + } + }, + "vlq": { + "version": "0.2.3", + "resolved": "https://registry.npmjs.org/vlq/-/vlq-0.2.3.tgz", + "integrity": "sha512-DRibZL6DsNhIgYQ+wNdWDL2SL3bKPlVrRiBqV5yuMm++op8W4kGFtaQfCs4KEJn0wBZcHVHJ3eoywX8983k1ow==" + }, + "vm-browserify": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/vm-browserify/-/vm-browserify-1.1.2.tgz", + "integrity": "sha512-2ham8XPWTONajOR0ohOKOHXkm3+gaBmGut3SRuu75xLd/RRaY6vqgh8NBYYk7+RW3u5AtzPQZG8F10LHkl0lAQ==" + }, + "w3c-hr-time": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/w3c-hr-time/-/w3c-hr-time-1.0.2.tgz", + "integrity": "sha512-z8P5DvDNjKDoFIHK7q8r8lackT6l+jo/Ye3HOle7l9nICP9lf1Ci25fy9vHd0JOWewkIFzXIEig3TdKT7JQ5fQ==", + "requires": { + "browser-process-hrtime": "^1.0.0" + } + }, + "w3c-xmlserializer": { + "version": "1.1.2", + "resolved": "https://registry.npmjs.org/w3c-xmlserializer/-/w3c-xmlserializer-1.1.2.tgz", + "integrity": "sha512-p10l/ayESzrBMYWRID6xbuCKh2Fp77+sA0doRuGn4tTIMrrZVeqfpKjXHY+oDh3K4nLdPgNwMTVP6Vp4pvqbNg==", + "requires": { + "domexception": "^1.0.1", + "webidl-conversions": "^4.0.2", + "xml-name-validator": "^3.0.0" + } + }, + "watchpack": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/watchpack/-/watchpack-2.2.0.tgz", + "integrity": "sha512-up4YAn/XHgZHIxFBVCdlMiWDj6WaLKpwVeGQk2I5thdYxF/KmF0aaz6TfJZ/hfl1h/XlcDr7k1KH7ThDagpFaA==", + "requires": { + "glob-to-regexp": "^0.4.1", + "graceful-fs": "^4.1.2" + }, + "dependencies": { + "glob-to-regexp": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/glob-to-regexp/-/glob-to-regexp-0.4.1.tgz", + "integrity": "sha512-lkX1HJXwyMcprw/5YUZc2s7DrpAiHB21/V+E1rHUrVNokkvB6bqMzT0VfV6/86ZNabt1k14YOIaT7nDvOX3Iiw==" + } + } + }, + "wbuf": { + "version": "1.7.3", + "resolved": "https://registry.npmjs.org/wbuf/-/wbuf-1.7.3.tgz", + "integrity": "sha512-O84QOnr0icsbFGLS0O3bI5FswxzRr8/gHwWkDlQFskhSPryQXvrTMxjxGP4+iWYoauLoBvfDpkrOauZ+0iZpDA==", + "requires": { + "minimalistic-assert": "^1.0.0" + } + }, + "wcwidth": { + "version": "1.0.1", + "resolved": "https://registry.npmjs.org/wcwidth/-/wcwidth-1.0.1.tgz", + "integrity": "sha1-8LDc+RW8X/FSivrbLA4XtTLaL+g=", + "requires": { + "defaults": "^1.0.3" + } + }, + "webidl-conversions": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/webidl-conversions/-/webidl-conversions-4.0.2.tgz", + "integrity": "sha512-YQ+BmxuTgd6UXZW3+ICGfyqRyHXVlD5GtQr5+qjiNW7bF0cqrzX500HVXPBOvgXb5YnzDd+h0zqyv61KUD7+Sg==" + }, + "webpack": { + "version": "5.40.0", + "resolved": "https://registry.npmjs.org/webpack/-/webpack-5.40.0.tgz", + "integrity": "sha512-c7f5e/WWrxXWUzQqTBg54vBs5RgcAgpvKE4F4VegVgfo4x660ZxYUF2/hpMkZUnLjgytVTitjeXaN4IPlXCGIw==", + "requires": { + "@types/eslint-scope": "^3.7.0", + "@types/estree": "^0.0.47", + "@webassemblyjs/ast": "1.11.0", + "@webassemblyjs/wasm-edit": "1.11.0", + "@webassemblyjs/wasm-parser": "1.11.0", + "acorn": "^8.2.1", + "browserslist": "^4.14.5", + "chrome-trace-event": "^1.0.2", + "enhanced-resolve": "^5.8.0", + "es-module-lexer": "^0.6.0", + "eslint-scope": "5.1.1", + "events": "^3.2.0", + "glob-to-regexp": "^0.4.1", + "graceful-fs": "^4.2.4", + "json-parse-better-errors": "^1.0.2", + "loader-runner": "^4.2.0", + "mime-types": "^2.1.27", + "neo-async": "^2.6.2", + "schema-utils": "^3.0.0", + "tapable": "^2.1.1", + "terser-webpack-plugin": "^5.1.3", + "watchpack": "^2.2.0", + "webpack-sources": "^2.3.0" + }, + "dependencies": { + "acorn": { + "version": "8.4.1", + "resolved": "https://registry.npmjs.org/acorn/-/acorn-8.4.1.tgz", + "integrity": "sha512-asabaBSkEKosYKMITunzX177CXxQ4Q8BSSzMTKD+FefUhipQC70gfW5SiUDhYQ3vk8G+81HqQk7Fv9OXwwn9KA==" + }, + "glob-to-regexp": { + "version": "0.4.1", + "resolved": "https://registry.npmjs.org/glob-to-regexp/-/glob-to-regexp-0.4.1.tgz", + "integrity": "sha512-lkX1HJXwyMcprw/5YUZc2s7DrpAiHB21/V+E1rHUrVNokkvB6bqMzT0VfV6/86ZNabt1k14YOIaT7nDvOX3Iiw==" + } + } + }, + "webpack-cli": { + "version": "4.7.2", + "resolved": "https://registry.npmjs.org/webpack-cli/-/webpack-cli-4.7.2.tgz", + "integrity": "sha512-mEoLmnmOIZQNiRl0ebnjzQ74Hk0iKS5SiEEnpq3dRezoyR3yPaeQZCMCe+db4524pj1Pd5ghZXjT41KLzIhSLw==", + "requires": { + "@discoveryjs/json-ext": "^0.5.0", + "@webpack-cli/configtest": "^1.0.4", + "@webpack-cli/info": "^1.3.0", + "@webpack-cli/serve": "^1.5.1", + "colorette": "^1.2.1", + "commander": "^7.0.0", + "execa": "^5.0.0", + "fastest-levenshtein": "^1.0.12", + "import-local": "^3.0.2", + "interpret": "^2.2.0", + "rechoir": "^0.7.0", + "v8-compile-cache": "^2.2.0", + "webpack-merge": "^5.7.3" + }, + "dependencies": { + "commander": { + "version": "7.2.0", + "resolved": "https://registry.npmjs.org/commander/-/commander-7.2.0.tgz", + "integrity": "sha512-QrWXB+ZQSVPmIWIhtEO9H+gwHaMGYiF5ChvoJ+K9ZGHG/sVsa6yiesAD1GC/x46sET00Xlwo1u49RVVVzvcSkw==" + }, + "cross-spawn": { + "version": "7.0.3", + "resolved": "https://registry.npmjs.org/cross-spawn/-/cross-spawn-7.0.3.tgz", + "integrity": "sha512-iRDPJKUPVEND7dHPO8rkbOnPpyDygcDFtWjpeWNCgy8WP2rXcxXL8TskReQl6OrB2G7+UJrags1q15Fudc7G6w==", + "requires": { + "path-key": "^3.1.0", + "shebang-command": "^2.0.0", + "which": "^2.0.1" + } + }, + "execa": { + "version": "5.1.1", + "resolved": "https://registry.npmjs.org/execa/-/execa-5.1.1.tgz", + "integrity": "sha512-8uSpZZocAZRBAPIEINJj3Lo9HyGitllczc27Eh5YYojjMFMn8yHMDMaUHE2Jqfq05D/wucwI4JGURyXt1vchyg==", + "requires": { + "cross-spawn": "^7.0.3", + "get-stream": "^6.0.0", + "human-signals": "^2.1.0", + "is-stream": "^2.0.0", + "merge-stream": "^2.0.0", + "npm-run-path": "^4.0.1", + "onetime": "^5.1.2", + "signal-exit": "^3.0.3", + "strip-final-newline": "^2.0.0" + } + }, + "get-stream": { + "version": "6.0.1", + "resolved": "https://registry.npmjs.org/get-stream/-/get-stream-6.0.1.tgz", + "integrity": "sha512-ts6Wi+2j3jQjqi70w5AlN8DFnkSwC+MqmxEzdEALB2qXZYV3X/b1CTfgPLGJNMeAWxdPfU8FO1ms3NUfaHCPYg==" + }, + "mimic-fn": { + "version": "2.1.0", + "resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz", + "integrity": "sha512-OqbOk5oEQeAZ8WXWydlu9HJjz9WVdEIvamMCcXmuqUYjTknH/sqsWvhQ3vgwKFRR1HpjvNBKQ37nbJgYzGqGcg==" + }, + "npm-run-path": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/npm-run-path/-/npm-run-path-4.0.1.tgz", + "integrity": "sha512-S48WzZW777zhNIrn7gxOlISNAqi9ZC/uQFnRdbeIHhZhCA6UqpkOT8T1G7BvfdgP4Er8gF4sUbaS0i7QvIfCWw==", + "requires": { + "path-key": "^3.0.0" + } + }, + "onetime": { + "version": "5.1.2", + "resolved": "https://registry.npmjs.org/onetime/-/onetime-5.1.2.tgz", + "integrity": "sha512-kbpaSSGJTWdAY5KPVeMOKXSrPtr8C8C7wodJbcsd51jRnmD+GZu8Y0VoU6Dm5Z4vWr0Ig/1NKuWRKf7j5aaYSg==", + "requires": { + "mimic-fn": "^2.1.0" + } + }, + "path-key": { + "version": "3.1.1", + "resolved": "https://registry.npmjs.org/path-key/-/path-key-3.1.1.tgz", + "integrity": "sha512-ojmeN0qd+y0jszEtoY48r0Peq5dwMEkIlCOu6Q5f41lfkswXuKtYrhgoTpLnyIcHm24Uhqx+5Tqm2InSwLhE6Q==" + }, + "shebang-command": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/shebang-command/-/shebang-command-2.0.0.tgz", + "integrity": "sha512-kHxr2zZpYtdmrN1qDjrrX/Z1rR1kG8Dx+gkpK1G4eXmvXswmcE1hTWBWYUzlraYw1/yZp6YuDY77YtvbN0dmDA==", + "requires": { + "shebang-regex": "^3.0.0" + } + }, + "shebang-regex": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/shebang-regex/-/shebang-regex-3.0.0.tgz", + "integrity": "sha512-7++dFhtcx3353uBaq8DDR4NuxBetBzC7ZQOhmTQInHEd6bSrXdiEyzCvG07Z44UYdLShWUyXt5M/yhz8ekcb1A==" + }, + "which": { + "version": "2.0.2", + "resolved": "https://registry.npmjs.org/which/-/which-2.0.2.tgz", + "integrity": "sha512-BLI3Tl1TW3Pvl70l3yq3Y64i+awpwXqsGBYWkkqMtnbXgrMD+yj7rhW0kuEDxzJaYXGjEW5ogapKNMEKNMjibA==", + "requires": { + "isexe": "^2.0.0" + } + } + } + }, + "webpack-dev-middleware": { + "version": "3.7.3", + "resolved": "https://registry.npmjs.org/webpack-dev-middleware/-/webpack-dev-middleware-3.7.3.tgz", + "integrity": "sha512-djelc/zGiz9nZj/U7PTBi2ViorGJXEWo/3ltkPbDyxCXhhEXkW0ce99falaok4TPj+AsxLiXJR0EBOb0zh9fKQ==", + "requires": { + "memory-fs": "^0.4.1", + "mime": "^2.4.4", + "mkdirp": "^0.5.1", + "range-parser": "^1.2.1", + "webpack-log": "^2.0.0" + }, + "dependencies": { + "mime": { + "version": "2.5.2", + "resolved": "https://registry.npmjs.org/mime/-/mime-2.5.2.tgz", + "integrity": "sha512-tqkh47FzKeCPD2PUiPB6pkbMzsCasjxAfC62/Wap5qrUWcb+sFasXUC5I3gYM5iBM8v/Qpn4UK0x+j0iHyFPDg==" + } + } + }, + "webpack-dev-server": { + "version": "3.11.2", + "resolved": "https://registry.npmjs.org/webpack-dev-server/-/webpack-dev-server-3.11.2.tgz", + "integrity": "sha512-A80BkuHRQfCiNtGBS1EMf2ChTUs0x+B3wGDFmOeT4rmJOHhHTCH2naNxIHhmkr0/UillP4U3yeIyv1pNp+QDLQ==", + "requires": { + "ansi-html": "0.0.7", + "bonjour": "^3.5.0", + "chokidar": "^2.1.8", + "compression": "^1.7.4", + "connect-history-api-fallback": "^1.6.0", + "debug": "^4.1.1", + "del": "^4.1.1", + "express": "^4.17.1", + "html-entities": "^1.3.1", + "http-proxy-middleware": "0.19.1", + "import-local": "^2.0.0", + "internal-ip": "^4.3.0", + "ip": "^1.1.5", + "is-absolute-url": "^3.0.3", + "killable": "^1.0.1", + "loglevel": "^1.6.8", + "opn": "^5.5.0", + "p-retry": "^3.0.1", + "portfinder": "^1.0.26", + "schema-utils": "^1.0.0", + "selfsigned": "^1.10.8", + "semver": "^6.3.0", + "serve-index": "^1.9.1", + "sockjs": "^0.3.21", + "sockjs-client": "^1.5.0", + "spdy": "^4.0.2", + "strip-ansi": "^3.0.1", + "supports-color": "^6.1.0", + "url": "^0.11.0", + "webpack-dev-middleware": "^3.7.2", + "webpack-log": "^2.0.0", + "ws": "^6.2.1", + "yargs": "^13.3.2" + }, + "dependencies": { + "ansi-regex": { + "version": "2.1.1", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-2.1.1.tgz", + "integrity": "sha1-w7M6te42DYbg5ijwRorn7yfWVN8=" + }, + "find-up": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-3.0.0.tgz", + "integrity": "sha512-1yD6RmLI1XBfxugvORwlck6f75tYL+iR0jqwsOrOxMZyGYqUuDhJ0l4AXdO1iX/FTs9cBAMEk1gWSEx1kSbylg==", + "requires": { + "locate-path": "^3.0.0" + } + }, + "import-local": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/import-local/-/import-local-2.0.0.tgz", + "integrity": "sha512-b6s04m3O+s3CGSbqDIyP4R6aAwAeYlVq9+WUWep6iHa8ETRf9yei1U48C5MmfJmV9AiLYYBKPMq/W+/WRpQmCQ==", + "requires": { + "pkg-dir": "^3.0.0", + "resolve-cwd": "^2.0.0" + } + }, + "is-absolute-url": { + "version": "3.0.3", + "resolved": "https://registry.npmjs.org/is-absolute-url/-/is-absolute-url-3.0.3.tgz", + "integrity": "sha512-opmNIX7uFnS96NtPmhWQgQx6/NYFgsUXYMllcfzwWKUMwfo8kku1TvE6hkNcH+Q1ts5cMVrsY7j0bxXQDciu9Q==" + }, + "locate-path": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-3.0.0.tgz", + "integrity": "sha512-7AO748wWnIhNqAuaty2ZWHkQHRSNfPVIsPIfwEOWO22AmaoVrWavlOcMR5nzTLNYvp36X220/maaRsrec1G65A==", + "requires": { + "p-locate": "^3.0.0", + "path-exists": "^3.0.0" + } + }, + "p-limit": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/p-limit/-/p-limit-2.3.0.tgz", + "integrity": "sha512-//88mFWSJx8lxCzwdAABTJL2MyWB12+eIY7MDL2SqLmAkeKU9qxRvWuSyTjm3FUmpBEMuFfckAIqEaVGUDxb6w==", + "requires": { + "p-try": "^2.0.0" + } + }, + "p-locate": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-3.0.0.tgz", + "integrity": "sha512-x+12w/To+4GFfgJhBEpiDcLozRJGegY+Ei7/z0tSLkMmxGZNybVMSfWj9aJn8Z5Fc7dBUNJOOVgPv2H7IwulSQ==", + "requires": { + "p-limit": "^2.0.0" + } + }, + "path-exists": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-3.0.0.tgz", + "integrity": "sha1-zg6+ql94yxiSXqfYENe1mwEP1RU=" + }, + "pkg-dir": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/pkg-dir/-/pkg-dir-3.0.0.tgz", + "integrity": "sha512-/E57AYkoeQ25qkxMj5PBOVgF8Kiu/h7cYS30Z5+R7WaiCCBfLq58ZI/dSeaEKb9WVJV5n/03QwrN3IeWIFllvw==", + "requires": { + "find-up": "^3.0.0" + } + }, + "resolve-cwd": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/resolve-cwd/-/resolve-cwd-2.0.0.tgz", + "integrity": "sha1-AKn3OHVW4nA46uIyyqNypqWbZlo=", + "requires": { + "resolve-from": "^3.0.0" + } + }, + "schema-utils": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/schema-utils/-/schema-utils-1.0.0.tgz", + "integrity": "sha512-i27Mic4KovM/lnGsy8whRCHhc7VicJajAjTrYg11K9zfZXnYIt4k5F+kZkwjnrhKzLic/HLU4j11mjsz2G/75g==", + "requires": { + "ajv": "^6.1.0", + "ajv-errors": "^1.0.0", + "ajv-keywords": "^3.1.0" + } + }, + "semver": { + "version": "6.3.0", + "resolved": "https://registry.npmjs.org/semver/-/semver-6.3.0.tgz", + "integrity": "sha512-b39TBaTSfV6yBrapU89p5fKekE2m/NwnDocOVruQFS1/veMgdzuPcnOM34M6CwxW8jH/lxEa5rBoDeUwu5HHTw==" + }, + "strip-ansi": { + "version": "3.0.1", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-3.0.1.tgz", + "integrity": "sha1-ajhfuIU9lS1f8F0Oiq+UJ43GPc8=", + "requires": { + "ansi-regex": "^2.0.0" + } + }, + "supports-color": { + "version": "6.1.0", + "resolved": "https://registry.npmjs.org/supports-color/-/supports-color-6.1.0.tgz", + "integrity": "sha512-qe1jfm1Mg7Nq/NSh6XE24gPXROEVsWHxC1LIx//XNlD9iw7YZQGjZNjYN7xGaEG6iKdA8EtNFW6R0gjnVXp+wQ==", + "requires": { + "has-flag": "^3.0.0" + } + }, + "ws": { + "version": "6.2.2", + "resolved": "https://registry.npmjs.org/ws/-/ws-6.2.2.tgz", + "integrity": "sha512-zmhltoSR8u1cnDsD43TX59mzoMZsLKqUweyYBAIvTngR3shc0W6aOZylZmq/7hqyVxPdi+5Ud2QInblgyE72fw==", + "requires": { + "async-limiter": "~1.0.0" + } + } + } + }, + "webpack-log": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/webpack-log/-/webpack-log-2.0.0.tgz", + "integrity": "sha512-cX8G2vR/85UYG59FgkoMamwHUIkSSlV3bBMRsbxVXVUk2j6NleCKjQ/WE9eYg9WY4w25O9w8wKP4rzNZFmUcUg==", + "requires": { + "ansi-colors": "^3.0.0", + "uuid": "^3.3.2" + } + }, + "webpack-merge": { + "version": "5.8.0", + "resolved": "https://registry.npmjs.org/webpack-merge/-/webpack-merge-5.8.0.tgz", + "integrity": "sha512-/SaI7xY0831XwP6kzuwhKWVKDP9t1QY1h65lAFLbZqMPIuYcD9QAW4u9STIbU9kaJbPBB/geU/gLr1wDjOhQ+Q==", + "requires": { + "clone-deep": "^4.0.1", + "wildcard": "^2.0.0" + } + }, + "webpack-sources": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/webpack-sources/-/webpack-sources-2.3.0.tgz", + "integrity": "sha512-WyOdtwSvOML1kbgtXbTDnEW0jkJ7hZr/bDByIwszhWd/4XX1A3XMkrbFMsuH4+/MfLlZCUzlAdg4r7jaGKEIgQ==", + "requires": { + "source-list-map": "^2.0.1", + "source-map": "^0.6.1" + } + }, + "websocket-driver": { + "version": "0.7.4", + "resolved": "https://registry.npmjs.org/websocket-driver/-/websocket-driver-0.7.4.tgz", + "integrity": "sha512-b17KeDIQVjvb0ssuSDF2cYXSg2iztliJ4B9WdsuB6J952qCPKmnVq4DyW5motImXHDC1cBT/1UezrJVsKw5zjg==", + "requires": { + "http-parser-js": ">=0.5.1", + "safe-buffer": ">=5.1.0", + "websocket-extensions": ">=0.1.1" + } + }, + "websocket-extensions": { + "version": "0.1.4", + "resolved": "https://registry.npmjs.org/websocket-extensions/-/websocket-extensions-0.1.4.tgz", + "integrity": "sha512-OqedPIGOfsDlo31UNwYbCFMSaO9m9G/0faIHj5/dZFDMFqPTcx6UwqyOy3COEaEOg/9VsGIpdqn62W5KhoKSpg==" + }, + "whatwg-encoding": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/whatwg-encoding/-/whatwg-encoding-1.0.5.tgz", + "integrity": "sha512-b5lim54JOPN9HtzvK9HFXvBma/rnfFeqsic0hSpjtDbVxR3dJKLc+KB4V6GgiGOvl7CY/KNh8rxSo9DKQrnUEw==", + "requires": { + "iconv-lite": "0.4.24" + } + }, + "whatwg-mimetype": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/whatwg-mimetype/-/whatwg-mimetype-2.3.0.tgz", + "integrity": "sha512-M4yMwr6mAnQz76TbJm914+gPpB/nCwvZbJU28cUD6dR004SAxDLOOSUaB1JDRqLtaOV/vi0IC5lEAGFgrjGv/g==" + }, + "whatwg-url": { + "version": "7.1.0", + "resolved": "https://registry.npmjs.org/whatwg-url/-/whatwg-url-7.1.0.tgz", + "integrity": "sha512-WUu7Rg1DroM7oQvGWfOiAK21n74Gg+T4elXEQYkOhtyLeWiJFoOGLXPKI/9gzIie9CtwVLm8wtw6YJdKyxSjeg==", + "requires": { + "lodash.sortby": "^4.7.0", + "tr46": "^1.0.1", + "webidl-conversions": "^4.0.2" + } + }, + "which": { + "version": "1.3.1", + "resolved": "https://registry.npmjs.org/which/-/which-1.3.1.tgz", + "integrity": "sha512-HxJdYWq1MTIQbJ3nw0cqssHoTNU267KlrDuGZ1WYlxDStUtKUhOaJmh112/TZmHxxUfuJqPXSOm7tDyas0OSIQ==", + "requires": { + "isexe": "^2.0.0" + } + }, + "which-boxed-primitive": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/which-boxed-primitive/-/which-boxed-primitive-1.0.2.tgz", + "integrity": "sha512-bwZdv0AKLpplFY2KZRX6TvyuN7ojjr7lwkg6ml0roIy9YeuSr7JS372qlNW18UQYzgYK9ziGcerWqZOmEn9VNg==", + "requires": { + "is-bigint": "^1.0.1", + "is-boolean-object": "^1.1.0", + "is-number-object": "^1.0.4", + "is-string": "^1.0.5", + "is-symbol": "^1.0.3" + } + }, + "which-module": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/which-module/-/which-module-2.0.0.tgz", + "integrity": "sha1-2e8H3Od7mQK4o6j6SzHD4/fm6Ho=" + }, + "wildcard": { + "version": "2.0.0", + "resolved": "https://registry.npmjs.org/wildcard/-/wildcard-2.0.0.tgz", + "integrity": "sha512-JcKqAHLPxcdb9KM49dufGXn2x3ssnfjbcaQdLlfZsL9rH9wgDQjUtDxbo8NE0F6SFvydeu1VhZe7hZuHsB2/pw==" + }, + "word-wrap": { + "version": "1.2.3", + "resolved": "https://registry.npmjs.org/word-wrap/-/word-wrap-1.2.3.tgz", + "integrity": "sha512-Hz/mrNwitNRh/HUAtM/VT/5VH+ygD6DV7mYKZAtHOrbs8U7lvPS6xf7EJKMF0uW1KJCl0H701g3ZGus+muE5vQ==" + }, + "wrap-ansi": { + "version": "5.1.0", + "resolved": "https://registry.npmjs.org/wrap-ansi/-/wrap-ansi-5.1.0.tgz", + "integrity": "sha512-QC1/iN/2/RPVJ5jYK8BGttj5z83LmSKmvbvrXPNCLZSEb32KKVDJDl/MOt2N01qU2H/FkzEa9PKto1BqDjtd7Q==", + "requires": { + "ansi-styles": "^3.2.0", + "string-width": "^3.0.0", + "strip-ansi": "^5.0.0" + }, + "dependencies": { + "ansi-regex": { + "version": "4.1.0", + "resolved": "https://registry.npmjs.org/ansi-regex/-/ansi-regex-4.1.0.tgz", + "integrity": "sha512-1apePfXM1UOSqw0o9IiFAovVz9M5S1Dg+4TrDwfMewQ6p/rmMueb7tWZjQ1rx4Loy1ArBggoqGpfqqdI4rondg==" + }, + "strip-ansi": { + "version": "5.2.0", + "resolved": "https://registry.npmjs.org/strip-ansi/-/strip-ansi-5.2.0.tgz", + "integrity": "sha512-DuRs1gKbBqsMKIZlrffwlug8MHkcnpjs5VPmL1PAh+mA30U0DTotfDZ0d2UUsXpPmPmMMJ6W773MaA3J+lbiWA==", + "requires": { + "ansi-regex": "^4.1.0" + } + } + } + }, + "wrappy": { + "version": "1.0.2", + "resolved": "https://registry.npmjs.org/wrappy/-/wrappy-1.0.2.tgz", + "integrity": "sha1-tSQ9jz7BqjXxNkYFvA0QNuMKtp8=" + }, + "ws": { + "version": "5.2.3", + "resolved": "https://registry.npmjs.org/ws/-/ws-5.2.3.tgz", + "integrity": "sha512-jZArVERrMsKUatIdnLzqvcfydI85dvd/Fp1u/VOpfdDWQ4c9qWXe+VIeAbQ5FrDwciAkr+lzofXLz3Kuf26AOA==", + "requires": { + "async-limiter": "~1.0.0" + } + }, + "xhr2": { + "version": "0.2.1", + "resolved": "https://registry.npmjs.org/xhr2/-/xhr2-0.2.1.tgz", + "integrity": "sha512-sID0rrVCqkVNUn8t6xuv9+6FViXjUVXq8H5rWOH2rz9fDNQEd4g0EA2XlcEdJXRz5BMEn4O1pJFdT+z4YHhoWw==" + }, + "xml-name-validator": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/xml-name-validator/-/xml-name-validator-3.0.0.tgz", + "integrity": "sha512-A5CUptxDsvxKJEU3yO6DuWBSJz/qizqzJKOMIfUJHETbBw/sFaDxgd6fxm1ewUaM0jZ444Fc5vC5ROYurg/4Pw==" + }, + "xmlchars": { + "version": "2.2.0", + "resolved": "https://registry.npmjs.org/xmlchars/-/xmlchars-2.2.0.tgz", + "integrity": "sha512-JZnDKK8B0RCDw84FNdDAIpZK+JuJw+s7Lz8nksI7SIuU3UXJJslUthsi+uWBUYOwPFwW7W7PRLRfUKpxjtjFCw==" + }, + "xtend": { + "version": "4.0.2", + "resolved": "https://registry.npmjs.org/xtend/-/xtend-4.0.2.tgz", + "integrity": "sha512-LKYU1iAXJXUgAXn9URjiu+MWhyUXHsvfp7mcuYm9dSUKK0/CjtrUwFAxD82/mCWbtLsGjFIad0wIsod4zrTAEQ==" + }, + "y18n": { + "version": "4.0.3", + "resolved": "https://registry.npmjs.org/y18n/-/y18n-4.0.3.tgz", + "integrity": "sha512-JKhqTOwSrqNA1NY5lSztJ1GrBiUodLMmIZuLiDaMRJ+itFd+ABVE8XBjOvIWL+rSqNDC74LCSFmlb/U4UZ4hJQ==" + }, + "yallist": { + "version": "2.1.2", + "resolved": "https://registry.npmjs.org/yallist/-/yallist-2.1.2.tgz", + "integrity": "sha1-HBH5IY8HYImkfdUS+TxmmaaoHVI=" + }, + "yargs": { + "version": "13.3.2", + "resolved": "https://registry.npmjs.org/yargs/-/yargs-13.3.2.tgz", + "integrity": "sha512-AX3Zw5iPruN5ie6xGRIDgqkT+ZhnRlZMLMHAs8tg7nRruy2Nb+i5o9bwghAogtM08q1dpr2LVoS8KSTMYpWXUw==", + "requires": { + "cliui": "^5.0.0", + "find-up": "^3.0.0", + "get-caller-file": "^2.0.1", + "require-directory": "^2.1.1", + "require-main-filename": "^2.0.0", + "set-blocking": "^2.0.0", + "string-width": "^3.0.0", + "which-module": "^2.0.0", + "y18n": "^4.0.0", + "yargs-parser": "^13.1.2" + }, + "dependencies": { + "find-up": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/find-up/-/find-up-3.0.0.tgz", + "integrity": "sha512-1yD6RmLI1XBfxugvORwlck6f75tYL+iR0jqwsOrOxMZyGYqUuDhJ0l4AXdO1iX/FTs9cBAMEk1gWSEx1kSbylg==", + "requires": { + "locate-path": "^3.0.0" + } + }, + "locate-path": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/locate-path/-/locate-path-3.0.0.tgz", + "integrity": "sha512-7AO748wWnIhNqAuaty2ZWHkQHRSNfPVIsPIfwEOWO22AmaoVrWavlOcMR5nzTLNYvp36X220/maaRsrec1G65A==", + "requires": { + "p-locate": "^3.0.0", + "path-exists": "^3.0.0" + } + }, + "p-limit": { + "version": "2.3.0", + "resolved": "https://registry.npmjs.org/p-limit/-/p-limit-2.3.0.tgz", + "integrity": "sha512-//88mFWSJx8lxCzwdAABTJL2MyWB12+eIY7MDL2SqLmAkeKU9qxRvWuSyTjm3FUmpBEMuFfckAIqEaVGUDxb6w==", + "requires": { + "p-try": "^2.0.0" + } + }, + "p-locate": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/p-locate/-/p-locate-3.0.0.tgz", + "integrity": "sha512-x+12w/To+4GFfgJhBEpiDcLozRJGegY+Ei7/z0tSLkMmxGZNybVMSfWj9aJn8Z5Fc7dBUNJOOVgPv2H7IwulSQ==", + "requires": { + "p-limit": "^2.0.0" + } + }, + "path-exists": { + "version": "3.0.0", + "resolved": "https://registry.npmjs.org/path-exists/-/path-exists-3.0.0.tgz", + "integrity": "sha1-zg6+ql94yxiSXqfYENe1mwEP1RU=" + } + } + }, + "yargs-parser": { + "version": "13.1.2", + "resolved": "https://registry.npmjs.org/yargs-parser/-/yargs-parser-13.1.2.tgz", + "integrity": "sha512-3lbsNRf/j+A4QuSZfDRA7HRSfWrzO0YjqTJd5kjAq37Zep1CEgaYmrH9Q3GwPiB9cHyd1Y1UwggGhJGoxipbzg==", + "requires": { + "camelcase": "^5.0.0", + "decamelize": "^1.2.0" + } + }, + "yocto-queue": { + "version": "0.1.0", + "resolved": "https://registry.npmjs.org/yocto-queue/-/yocto-queue-0.1.0.tgz", + "integrity": "sha512-rVksvsnNCdJ/ohGc6xgPwyN8eheCxsiLM8mxuE/t/mOVqJewPuO1miLpTHQiRgTKCLexL4MeAFVagts7HmNZ2Q==" + }, + "zen-observable": { + "version": "0.8.15", + "resolved": "https://registry.npmjs.org/zen-observable/-/zen-observable-0.8.15.tgz", + "integrity": "sha512-PQ2PC7R9rslx84ndNBZB/Dkv8V8fZEpk83RLgXtYd0fwUgEjseMn1Dgajh2x6S8QbZAFa9p2qVCEuYZNgve0dQ==" + } + } +} diff --git a/mlabs/hie.yaml b/mlabs/hie.yaml new file mode 100644 index 000000000..04cd24395 --- /dev/null +++ b/mlabs/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: diff --git a/mlabs/mlabs-plutus-use-cases.cabal b/mlabs/mlabs-plutus-use-cases.cabal index d49a68a2b..ce61021ac 100644 --- a/mlabs/mlabs-plutus-use-cases.cabal +++ b/mlabs/mlabs-plutus-use-cases.cabal @@ -57,6 +57,8 @@ library Mlabs.Data.Maybe Mlabs.Data.Ray Mlabs.Data.Ord + Mlabs.Demo.Contract.Burn + Mlabs.Demo.Contract.Mint Mlabs.Emulator.App Mlabs.Emulator.Blockchain Mlabs.Emulator.Scene @@ -272,6 +274,7 @@ Test-suite mlabs-plutus-use-cases-tests hs-source-dirs: test Main-is: Main.hs Other-modules: + Test.Demo.Contract.Mint Test.Lending.Contract Test.Lending.Init Test.Lending.Logic diff --git a/mlabs/shell.nix b/mlabs/shell.nix index ac5d69593..0f2da45c1 100644 --- a/mlabs/shell.nix +++ b/mlabs/shell.nix @@ -33,6 +33,7 @@ with import ./nix { }; git ghc nixfmt + plutus.plutus.haskell-language-server # Pab pab.plutus_pab_client diff --git a/mlabs/src/Mlabs/Demo/Contract/Burn.hs b/mlabs/src/Mlabs/Demo/Contract/Burn.hs new file mode 100644 index 000000000..d10dbb492 --- /dev/null +++ b/mlabs/src/Mlabs/Demo/Contract/Burn.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} + +module Mlabs.Demo.Contract.Burn + ( burnScrAddress + , burnValHash + ) where + +import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..)) + +import qualified Ledger as Ledger +import Ledger.Contexts +import Ledger.Scripts +import qualified Ledger.Typed.Scripts as Scripts +import qualified PlutusTx as PlutusTx + +{-# INLINABLE mkValidator #-} +-- | A validator script that can be used to burn any tokens sent to it. +mkValidator :: () -> () -> ScriptContext -> Bool +mkValidator _ _ _ = False + +data Burning +instance Scripts.ScriptType Burning where + type DatumType Burning = () + type RedeemerType Burning = () + +burnInst :: Scripts.ScriptInstance Burning +burnInst = Scripts.validator @Burning + $$(PlutusTx.compile [|| mkValidator ||]) + $$(PlutusTx.compile [|| wrap ||]) + where + wrap = Scripts.wrapValidator @() @() + +burnValidator :: Validator +burnValidator = Scripts.validatorScript burnInst + +burnValHash :: Ledger.ValidatorHash +burnValHash = validatorHash burnValidator + +burnScrAddress :: Ledger.Address +burnScrAddress = Scripts.scriptAddress burnInst \ No newline at end of file diff --git a/mlabs/src/Mlabs/Demo/Contract/Mint.hs b/mlabs/src/Mlabs/Demo/Contract/Mint.hs new file mode 100644 index 000000000..4ede0bdac --- /dev/null +++ b/mlabs/src/Mlabs/Demo/Contract/Mint.hs @@ -0,0 +1,134 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} + +module Mlabs.Demo.Contract.Mint + ( curPolicy + , curSymbol + , mintContract + , mintEndpoints + , MintParams (..) + , MintSchema + ) where + +import PlutusTx.Prelude hiding (Monoid(..), Semigroup(..), null) + +import Plutus.Contract as Contract +import qualified Ledger as Ledger +import qualified Ledger.Ada as Ada +import qualified Ledger.Constraints as Constraints +import Ledger.Contexts +import Ledger.Scripts +import qualified Ledger.Typed.Scripts as Scripts +import Ledger.Value (CurrencySymbol, TokenName) +import qualified Ledger.Value as Value +import qualified PlutusTx as PlutusTx + +import Control.Monad +import Data.Aeson (FromJSON, ToJSON) +import Data.Text hiding (all, filter, foldr) +import Data.Void +import GHC.Generics (Generic) +import Prelude (Semigroup(..)) +import Schema (ToSchema) + +import Mlabs.Demo.Contract.Burn + +------------------------------------------------------------------------------ +-- On-chain code. + +{-# INLINABLE mkPolicy #-} +-- | A monetary policy that mints arbitrary tokens for an equal amount of Ada. +-- For simplicity, the Ada are sent to a burn address. +mkPolicy :: Ledger.Address -> ScriptContext -> Bool +mkPolicy burnAddr ctx = + traceIfFalse "Insufficient Ada paid" isPaid + && traceIfFalse "Forged amount is invalid" isForgeValid + where + txInfo :: TxInfo + txInfo = scriptContextTxInfo ctx + + outputs :: [TxOut] + outputs = txInfoOutputs txInfo + + forged :: [(CurrencySymbol, TokenName, Integer)] + forged = Value.flattenValue $ txInfoForge txInfo + + forgedQty :: Integer + forgedQty = foldr (\(_, _, amt) acc -> acc + amt) 0 forged + + isToBurnAddr :: TxOut -> Bool + isToBurnAddr o = txOutAddress o == burnAddr + + isPaid :: Bool + isPaid = + let + adaVal = + Ada.fromValue $ mconcat $ txOutValue <$> filter isToBurnAddr outputs + in Ada.getLovelace adaVal >= forgedQty * tokenToLovelaceXR + + isForgeValid :: Bool + isForgeValid = all isValid forged + where isValid (_, _, amt) = amt > 0 + + +curPolicy :: MonetaryPolicy +curPolicy = mkMonetaryPolicyScript $ + $$(PlutusTx.compile [|| Scripts.wrapMonetaryPolicy . mkPolicy ||]) + `PlutusTx.applyCode` PlutusTx.liftCode burnScrAddress + +curSymbol :: CurrencySymbol +curSymbol = Ledger.scriptCurrencySymbol curPolicy + +-- For demo purposes, all tokens will be minted for a price of 1 Ada. +tokenToLovelaceXR :: Integer +tokenToLovelaceXR = 1_000_000 + +------------------------------------------------------------------------------ +-- Off-chain code. + +data MintParams = MintParams + { mpTokenName :: !TokenName + , mpAmount :: !Integer + } + deriving (Generic, ToJSON, FromJSON, ToSchema) + +type MintSchema = + BlockchainActions + .\/ Endpoint "mint" MintParams + +-- | Generates tokens with the specified name/amount and burns an equal amount of Ada. +mintContract :: MintParams -> Contract w MintSchema Text () +mintContract mp = do + let + tn = mpTokenName mp + amt = mpAmount mp + payVal = Ada.lovelaceValueOf $ amt * tokenToLovelaceXR + forgeVal = Value.singleton curSymbol tn amt + lookups = Constraints.monetaryPolicy curPolicy + tx = + Constraints.mustPayToOtherScript + burnValHash + (Datum $ PlutusTx.toData ()) + payVal + <> Constraints.mustForgeValue forgeVal + ledgerTx <- submitTxConstraintsWith @Void lookups tx + void $ awaitTxConfirmed $ Ledger.txId ledgerTx + +mintEndpoints :: Contract () MintSchema Text () +mintEndpoints = mint >> mintEndpoints where mint = endpoint @"mint" >>= mintContract diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index 0ea5120de..c24cbf035 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -8,6 +8,7 @@ import qualified Test.Lending.Logic as Lending.Logic import qualified Test.Lending.QuickCheck as Lending.QuickCheck import qualified Test.Nft.Logic as Nft.Logic import qualified Test.Nft.Contract as Nft.Contract +import qualified Test.Demo.Contract.Mint as Demo.Contract.Mint main :: IO () main = defaultMain $ testGroup "tests" @@ -16,6 +17,7 @@ main = defaultMain $ testGroup "tests" , testGroup "Lending" [ Lending.Logic.test , contract Lending.Contract.test , Lending.QuickCheck.test ] + , testGroup "Demo" [ Demo.Contract.Mint.test ] ] where contract diff --git a/mlabs/test/Test/Demo/Contract/Mint.hs b/mlabs/test/Test/Demo/Contract/Mint.hs new file mode 100644 index 000000000..6a6e104ae --- /dev/null +++ b/mlabs/test/Test/Demo/Contract/Mint.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE NumericUnderscores #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Test.Demo.Contract.Mint + ( test + ) where + +import Control.Lens +import Control.Monad hiding (fmap) +import qualified Data.Map as Map +import Ledger +import Ledger.Ada as Ada +import Ledger.Value +import Plutus.Contract.Test +import Plutus.Trace.Emulator as Emulator +import PlutusTx.Prelude +import Test.Tasty + +import Mlabs.Demo.Contract.Mint + +test :: TestTree +test = checkPredicateOptions + (defaultCheckOptions & emulatorConfig .~ emCfg) + "mint trace" + ( walletFundsChange + (Wallet 1) + (Ada.lovelaceValueOf (-15_000_000) <> assetClassValue usdToken 15) + .&&. walletFundsChange + (Wallet 2) + ( Ada.lovelaceValueOf (-50_000_000) + <> assetClassValue usdToken 20 + <> assetClassValue cadToken 30 + ) + ) + mintTrace + +emCfg :: EmulatorConfig +emCfg = EmulatorConfig $ Left $ Map.fromList [(Wallet 1, v), (Wallet 2, v)] + where + v :: Value + v = Ada.lovelaceValueOf 100_000_000 + +usd :: TokenName +usd = "USD" + +cad :: TokenName +cad = "CAD" + +usdToken :: AssetClass +usdToken = AssetClass (curSymbol, usd) + +cadToken :: AssetClass +cadToken = AssetClass (curSymbol, cad) + +mintTrace :: EmulatorTrace () +mintTrace = do + h1 <- activateContractWallet (Wallet 1) mintEndpoints + h2 <- activateContractWallet (Wallet 2) mintEndpoints + + -- Scenario 1: Buy single currency. + callEndpoint @"mint" h1 MintParams { mpTokenName = usd, mpAmount = 5 } + void $ Emulator.waitNSlots 2 + callEndpoint @"mint" h1 MintParams { mpTokenName = usd, mpAmount = 10 } + void $ Emulator.waitNSlots 2 + + -- Scenario 2: Buy multiple currencies. + callEndpoint @"mint" h2 MintParams { mpTokenName = usd, mpAmount = 20 } + void $ Emulator.waitNSlots 2 + callEndpoint @"mint" h2 MintParams { mpTokenName = cad, mpAmount = 30 } + void $ Emulator.waitNSlots 2 + + + + + From c9ab207d6179cc6b5c1c1ea1549f72d0901f1fa4 Mon Sep 17 00:00:00 2001 From: Hamdalah Date: Fri, 2 Jul 2021 16:37:14 +0200 Subject: [PATCH 81/81] explictly export modules in files without current exports --- mlabs/lendex-demo/Main.hs | 9 ++++++++- mlabs/nft-demo/Main.hs | 8 +++++++- mlabs/src/Mlabs/Nft/Logic/React.hs | 2 +- mlabs/test/Main.hs | 2 +- 4 files changed, 17 insertions(+), 4 deletions(-) diff --git a/mlabs/lendex-demo/Main.hs b/mlabs/lendex-demo/Main.hs index 6f96d055c..275e9c0bc 100644 --- a/mlabs/lendex-demo/Main.hs +++ b/mlabs/lendex-demo/Main.hs @@ -1,5 +1,12 @@ -- | Console demo for Lendex -module Main where +module Main (main, +initContract, +activateInit, +activateAdmin, +activateUser, +activateOracle, +startParams, +toCoin) where import Prelude diff --git a/mlabs/nft-demo/Main.hs b/mlabs/nft-demo/Main.hs index 5f84c087f..716996805 100644 --- a/mlabs/nft-demo/Main.hs +++ b/mlabs/nft-demo/Main.hs @@ -1,5 +1,11 @@ -- | Simulator demo for NFTs -module Main where +module Main( + main + , activateStartNft + , activateUser + , nftContent + , startParams + ) where import Prelude import Control.Monad.IO.Class diff --git a/mlabs/src/Mlabs/Nft/Logic/React.hs b/mlabs/src/Mlabs/Nft/Logic/React.hs index fb18d4a35..ca7d149cf 100644 --- a/mlabs/src/Mlabs/Nft/Logic/React.hs +++ b/mlabs/src/Mlabs/Nft/Logic/React.hs @@ -6,7 +6,7 @@ {-# OPTIONS_GHC -fno-ignore-interface-pragmas #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} -- | Transition function for NFTs -module Mlabs.Nft.Logic.React where +module Mlabs.Nft.Logic.React(react, checkInputs) where import Control.Monad.State.Strict (modify', gets) diff --git a/mlabs/test/Main.hs b/mlabs/test/Main.hs index bb32a12e9..42aafd4a6 100644 --- a/mlabs/test/Main.hs +++ b/mlabs/test/Main.hs @@ -1,4 +1,4 @@ -module Main where +module Main (main) where import Test.Tasty import Test.Tasty.ExpectedFailure (ignoreTest)