diff --git a/CHANGELOG.md b/CHANGELOG.md index c9a52f707b..531bcb9c33 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -47,7 +47,11 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) - `Contract.Transaction.getTxByHash` to retrieve contents of an on-chain transaction. - `project.launchSearchablePursDocs` to create an `apps` output for serving Pursuit documentation locally ([#816](https://github.com/Plutonomicon/cardano-transaction-lib/issues/816)) - `KeyWallet.MintsAndSendsToken` example ([#802](https://github.com/Plutonomicon/cardano-transaction-lib/pull/802)) +- `Contract.PlutusData.IsData` type class (`ToData` + `FromData`) ([#809](https://github.com/Plutonomicon/cardano-transaction-lib/pull/809)) - A check for port availability before Plutip runtime initialization attempt ([#837](https://github.com/Plutonomicon/cardano-transaction-lib/issues/837)) +- `Contract.Address.addressToBech32` and `Contract.Address.addressWithNetworkTagToBech32` ([#846](https://github.com/Plutonomicon/cardano-transaction-lib/issues/846)) +- `doc/e2e-testing.md` describes the process of E2E testing. ([#814](https://github.com/Plutonomicon/cardano-transaction-lib/pull/814)) +- Added unzip to the `devShell`. New `purescriptProject.shell` flag `withChromium` also optionally adds Chromium to the `devShell` ([#799](https://github.com/Plutonomicon/cardano-transaction-lib/pull/799)) ### Changed @@ -61,6 +65,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) - ServerConfig accepts a url `path` field ([#728](https://github.com/Plutonomicon/cardano-transaction-lib/issues/728)). - Examples now wait for transactions to be confirmed and log success ([#739](https://github.com/Plutonomicon/cardano-transaction-lib/issues/739)). - Updated CSL version to v11.0.0 ([#801](https://github.com/Plutonomicon/cardano-transaction-lib/issues/801)) +- Better error message when attempting to initialize a wallet in NodeJS environment ([#778](https://github.com/Plutonomicon/cardano-transaction-lib/issues/778)) - The [`ctl-scaffold`](https://github.com/mlabs-haskell/ctl-scaffold) repository has been archived and deprecated and its contents moved to `templates.ctl-scaffold` in the CTL flake ([#760](https://github.com/Plutonomicon/cardano-transaction-lib/issues/760)). - The CTL `overlay` output has been deprecated and replaced by `overlays.purescript` and `overlays.runtime` ([#796](https://github.com/Plutonomicon/cardano-transaction-lib/issues/796)). - `buildCtlRuntime` and `launchCtlRuntime` now take an `extraServices` argument to add `docker-compose` services to the resulting Arion expression ([#769](https://github.com/Plutonomicon/cardano-transaction-lib/issues/769)). @@ -85,6 +90,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) See https://github.com/cardano-foundation/CIPs/issues/303 for motivation - `ogmios-datum-cache` now works on `x86_64-darwin` +- `TypedValidator` interface ([#808](https://github.com/Plutonomicon/cardano-transaction-lib/issues/808)) ## [2.0.0-alpha] - 2022-07-05 diff --git a/doc/e2e-testing.md b/doc/e2e-testing.md new file mode 100644 index 0000000000..65f34ad72d --- /dev/null +++ b/doc/e2e-testing.md @@ -0,0 +1,133 @@ +# E2E Testing in the Browser + +CTL has basic machinery for E2E testing in the browser. This can be used to either run the included examples (in `examples`) or create a custom test suite for E2E testing. + +- [E2E Testing in the Browser](#e2e-testing-in-the-browser) +- [Parts Involved](#parts-involved) +- [How to Run the Included Examples](#how-to-run-the-included-examples) +- [Accepted Command Line Options](#accepted-command-line-options) +- [How Wallets are Used](#how-wallets-are-used) + - [How to Use a Different Version of a Wallet](#how-to-use-a-different-version-of-a-wallet) + - [Where to Find the Installed Extensions](#where-to-find-the-installed-extensions) + - [Re-Package an Extension as a CRX File](#re-package-an-extension-as-a-crx-file) + - [Use a CRX File](#use-a-crx-file) + - [How to Use a Different User Wallet](#how-to-use-a-different-user-wallet) +- [How to Create Your Own Test Suite](#how-to-create-your-own-test-suite) +- [Using a reproducible `chromium` version](#using-a-reproducible-chromium-version) + +## Parts Involved + +[Puppeteer](https://github.com/puppeteer/puppeteer) (driven by [Toppokki](https://github.com/justinwoo/purescript-toppokki)) +is used to drive the tests. Supported browsers are [Chromium](https://www.chromium.org/) and Google Chrome. +The browser can be run headless (default) or headful (useful during test development). + +Any programs that should be tested must be deployed and running on some testserver (e.g. with `make run-dev` for the included examples). + +An executable for concrete tests is also needed. For a working example see `test/E2E.purs`. + +## How to Run the Included Examples + +The process is as follows: + +1. Set `ps-entrypoint` in Makefile to `Examples.ByURL`. +2. run `make run-dev`. +3. In another shell, run `make e2e-test`. +4. Examples will be run headless by default. In case of errors, the browser console will be printed to the console. + +## Accepted Command Line Options + +The provided test suite accepts some options. These can be passed via `make` after an additional double dash `--`, e.g. `make e2e-test -- --no-headless`. For usage examples, see the invocations in the `Makefile`, for a complete explanation, see `src/Contract/Test/E2E/Browser.purs`. + +## How Wallets are Used + +For purposes of testing, there are two parts to using a wallet: providing the right software version and importing a wallet with enough assets and a known password. + +- The software just needs to be unpacked to some directory. This can either be the location where the browser unpacks it, or the result of unpacking a CRX file (see below). +- We provide the wallet data as tarballs which will be unpacked into the chrome profile before a test run. + +### How to Use a Different Version of a Wallet + +Chrome extensions are unpacked to some directory by the browser. From there, they can either be used directly by the tests (which gives no control over upgrades and instead uses always the current version), or they can be repackaged as CRX files. The default setup provides CRX versions which `make e2e-test` automatically unpacks on each test run. + +The default test suite accepts the arguments `--nami-dir` and `--gero-dir` to point to the directories from which the extensions are loaded. (see the Makefile) In order to use the "live" version of an extension, just pass the arguments accordingly, e.g.: + +``` +@spago test --main Test.E2E -a "E2ETest --nami-dir ~/.config/google-chrome/Default/Extensions/lpfcbjknijpeeillifnkikgncikgfhdo/ --gero-dir ~/.config/google-chrome/Default/Extensions/iifeegfcfhlhhnilhfoeihllenamcfgc --chrome-exe google-chome +``` + +### Where to Find the Installed Extensions + +1. Locate your browser profile directory. Commonly used locations include: `~/.config/{google-chrome,chromium}/Default` (where `Default` is the profile name), `~/snap/chromium/common/chromium/Default`. +2. Make sure that inside the profile, your desired extension is unpacked. Nami should be in `Extensions/lpfcbjknijpeeillifnkikgncikgfhdo`, Gero (testnet version) in `Extensions/iifeegfcfhlhhnilhfoeihllenamcfgc`. +3. Add the version as a subdirectory, too. The final path may look like `/home/user/.config/google-chrome/Default/Extensions/iifeegfcfhlhhnilhfoeihllenamcfgc/1.10.9_0` + +### Re-Package an Extension as a CRX File + +1. Make sure your browser is using the desired extension version. +2. Navigate to chrome://extensions/ +3. Click the extension. +4. Switch on "Developer mode" (upper right corner). +5. Click "Pack extension". +6. Paste the extension's directory (see above) into "Extension root directory". You can leave "Private key file" empty. +7. Click "Pack extension". +8. The path of the CRX file is displayed in the browser. + +(See [puppeteer-crx](https://www.npmjs.com/package/puppeteer-crx) for an effort to automate this process.) + +### Use a CRX File + +We use `unzip` to unpack it. However, `unzip` will issue a warning because of extra bytes at the beginning, and will exit with a non-zero code, so the exit code needs to be ignored. (we use `|| echo to achieve that`). + +See the `Makefile` for an example: + +``` +e2e-test-nami := test-data/chrome-extensions/nami_3.2.5_1.crx +unzip ${e2e-test-nami} -d ${e2e-temp-dir}/nami > /dev/zero || echo "ignore warnings" +``` + +`${e2e-temp-dir}/nami` can then be passed to the test suite as nami directory. + +### How to Use a Different User Wallet + +In the test suite, the wallet settings are just unpacked using `tar xzf ${e2e-test-nami-settings}` (see `Makefile`). + +A new settings tarball can be easily created, for example using the `Makefile`: + +1. Adjust `${e2e-test-nami-settings}`, `${e2e-test-gero-settings}` and `${e2e-test-chrome-dir}` to point to where you want to store the settings and to chromes user-profile directory +2. Run `make e2e-run-browser-gero` or `make e2e-run-browser-nami` to fire up the test browser with one of the wallets loaded. Configure your wallet as usual. +3. Run `make nami-settings` or `make gero-settings` to store the settings to a tarball. + +## How to Create Your Own Test Suite + +If you are using CTL as a library, you can and should create your own test suite to test your own contracts. + +1. Take `test/E2E.purs` as inspiration and create your own binary. You will find the necessary machinery in `Contract.Test.E2E`. Notable components: + - `withBrowser`: bracket to launch the browser with a specific extension, run something and clos the browser. + - `parseOptions`: Parses command line options, in case you want to use the same as our example suite. + - `publishTestFeedback`, `resetTestFeedback`, `retrieveTestFeedback`: Can be used to communicate success or failure from a contract to the tests. + - `geroConfirmAccess`, `geroSign`, `namiConfirmAccess`, `namiSign`: Confirm a transaction in the browser (i.e. enter the password, click "Sign") + - `withExample`: navigate to a URL, detect the wallet and get ready to run a contract. +2. Fire up your own contracts. +3. Take the `Makefile` as an inspiration, prepare your wallets and run the tests. + +## Using a reproducible `chromium` version + +Although most users will have some version of Chromium or Google Chrome installed system-wide, it can be a good idea to use the same version for all e2e testing. When creating your project's `devShell` using `purescriptProject`, you can set the `shell.withChromium` flag to `true` to include it in the shell's packages. This will be the version of `chromium` present in the `nixpkgs` you pass to create your project: + +```nix +{ + projectFor = system: + let + pkgs = nixpkgsFor system; + in + pkgs.purescriptProject { + inherit pkgs; + projectName = "my-project"; + shell = { + withChromium = true; + # ... + }; + # ... + }; +} +``` diff --git a/doc/plutus-comparison.md b/doc/plutus-comparison.md index 461177b362..7ecc5b1f9c 100644 --- a/doc/plutus-comparison.md +++ b/doc/plutus-comparison.md @@ -91,16 +91,18 @@ class ValidatorTypes (a :: Type) where Purescript lacks most of Haskell's more advanced type-level faculties, including type/data families. Purescript does, however, support functional dependencies, allowing us to encode `ValidatorTypes` as follows: ```purescript +class ValidatorTypes :: Type -> Type -> Type -> Constraint class - ( DatumType a b - , RedeemerType a b + ( DatumType validator datum + , RedeemerType validator redeemer ) <= - ValidatorTypes (a :: Type) (b :: Type) - | a -> b + ValidatorTypes validator datum redeemer -class DatumType (a :: Type) (b :: Type) | a -> b +class DatumType :: Type -> Type -> Constraint +class DatumType validator datum | validator -> datum -class RedeemerType (a :: Type) (b :: Type) | a -> b +class RedeemerType :: Type -> Type -> Constraint +class RedeemerType validator redeemer | validator -> redeemer ``` ### Working with scripts diff --git a/examples/KeyWallet/MintsAndSendsToken.js b/examples/KeyWallet/MintsAndSendsToken.js deleted file mode 100644 index 13913b2b88..0000000000 --- a/examples/KeyWallet/MintsAndSendsToken.js +++ /dev/null @@ -1 +0,0 @@ -exports.alwaysMints = require("Scripts/always-mints.plutus"); diff --git a/examples/KeyWallet/MintsAndSendsToken.purs b/examples/KeyWallet/MintsAndSendsToken.purs index 5681dda895..c34f3af8d0 100644 --- a/examples/KeyWallet/MintsAndSendsToken.purs +++ b/examples/KeyWallet/MintsAndSendsToken.purs @@ -2,7 +2,7 @@ -- | balance, and submit a smart-contract transaction. It creates a transaction -- | that mints a token using the `AlwaysMints` policy and sends it along with -- | the selected amount to the specified address. -module Examples.KeyWallet.MintsAndSendsToken where +module Examples.KeyWallet.MintsAndSendsToken (main) where import Contract.Prelude @@ -24,6 +24,7 @@ import Contract.TextEnvelope import Contract.Transaction (balanceAndSignTx, submit) import Contract.TxConstraints as Constraints import Contract.Value as Value +import Examples.AlwaysMints (alwaysMintsPolicy) import Examples.KeyWallet.Internal.Pkh2PkhContract (runKeyWalletContract_) main :: Effect Unit @@ -52,9 +53,3 @@ main = runKeyWalletContract_ \pkh lovelace unlock -> do txId <- submit bsTx logInfo' $ "Tx ID: " <> show txId liftEffect unlock - -foreign import alwaysMints :: String - -alwaysMintsPolicy :: Contract () MintingPolicy -alwaysMintsPolicy = wrap <<< wrap <$> textEnvelopeBytes alwaysMints - PlutusScriptV1 diff --git a/nix/default.nix b/nix/default.nix index 7f09f6f303..99c4107c82 100644 --- a/nix/default.nix +++ b/nix/default.nix @@ -82,6 +82,7 @@ let # If `true`, `npm i` will only write to your `package-lock.json` instead # of installing to a local `node_modules` , packageLockOnly ? false + , withChromium ? false }: assert pkgs.lib.assertOneOf "formatter" formatter [ "purs-tidy" "purty" ]; pkgs.mkShell { @@ -95,9 +96,13 @@ let pkgs.easy-ps.psa pkgs.easy-ps.spago2nix pkgs.nodePackages.node2nix + pkgs.unzip ] ++ pkgs.lib.lists.optional pursls - pkgs.easy-ps.purescript-language-server; + pkgs.easy-ps.purescript-language-server + ++ pkgs.lib.lists.optional + withChromium + pkgs.chromium; inherit packages inputsFrom; shellHook = '' export NODE_PATH="${nodeModules}/lib/node_modules" diff --git a/src/Contract/Address.purs b/src/Contract/Address.purs index 26cb46e000..ef87c12e0e 100644 --- a/src/Contract/Address.purs +++ b/src/Contract/Address.purs @@ -4,6 +4,8 @@ module Contract.Address , enterpriseAddressStakeValidatorHash , enterpriseAddressValidatorHash , getNetworkId + , addressWithNetworkTagToBech32 + , addressToBech32 , getWalletAddress , getWalletCollateral , module ByteArray @@ -12,6 +14,7 @@ module Contract.Address , module ExportUnbalancedTransaction , module Hash , module SerializationAddress + , module TypeAliases , ownPaymentPubKeyHash , ownPubKeyHash , ownStakePubKeyHash @@ -44,7 +47,11 @@ import Plutus.Conversion , toPlutusAddress , toPlutusTxUnspentOutput ) -import Plutus.Types.Address (Address) +import Plutus.Conversion.Address (fromPlutusAddressWithNetworkTag) +import Plutus.Types.Address + ( Address + , AddressWithNetworkTag(AddressWithNetworkTag) + ) import Plutus.Types.Address ( Address , AddressWithNetworkTag(AddressWithNetworkTag) @@ -68,7 +75,7 @@ import Scripts , validatorHashBaseAddress , validatorHashEnterpriseAddress ) as Scripts -import Serialization.Address (NetworkId(MainnetId)) +import Serialization.Address (NetworkId(MainnetId), addressBech32) import Serialization.Address ( Slot(Slot) , BlockId(BlockId) @@ -80,6 +87,8 @@ import Serialization.Address ) as SerializationAddress import Serialization.Hash (Ed25519KeyHash) as Hash import Serialization.Hash (ScriptHash) +import Types.Aliases (Bech32String) +import Types.Aliases (Bech32String) as TypeAliases import Types.ByteArray (ByteArray) as ByteArray import Types.PubKeyHash ( PaymentPubKeyHash(PaymentPubKeyHash) @@ -154,6 +163,20 @@ getNetworkId = wrapContract Address.getNetworkId -- `module Address` -------------------------------------------------------------------------------- +-- | Convert `Address` to `Bech32String`, using given `NetworkId` to determine +-- | Bech32 prefix. +addressWithNetworkTagToBech32 :: AddressWithNetworkTag -> Bech32String +addressWithNetworkTagToBech32 = fromPlutusAddressWithNetworkTag >>> + addressBech32 + +-- | Convert `Address` to `Bech32String`, using current `NetworkId` provided by +-- | `Contract` configuration to determine the network tag. +addressToBech32 :: forall (r :: Row Type). Address -> Contract r Bech32String +addressToBech32 address = do + networkId <- getNetworkId + pure $ addressWithNetworkTagToBech32 + (AddressWithNetworkTag { address, networkId }) + -- | Get the `ValidatorHash` with an Plutus `Address` enterpriseAddressValidatorHash :: Address -> Maybe ValidatorHash enterpriseAddressValidatorHash = diff --git a/src/Contract/PlutusData.purs b/src/Contract/PlutusData.purs index 0b473519b5..3a1c4de723 100644 --- a/src/Contract/PlutusData.purs +++ b/src/Contract/PlutusData.purs @@ -9,6 +9,7 @@ module Contract.PlutusData , module Datum , module ExportQueryM , module Hashing + , module IsData , module PlutusData , module Redeemer , module FromData @@ -95,6 +96,7 @@ import Types.Redeemer , redeemerHash , unitRedeemer ) as Redeemer +import IsData (class IsData) as IsData -- | Get a `PlutusData` given a `DatumHash`. getDatumByHash diff --git a/src/Contract/ScriptLookups.purs b/src/Contract/ScriptLookups.purs index a8fe2459c7..f5fa0c8d00 100644 --- a/src/Contract/ScriptLookups.purs +++ b/src/Contract/ScriptLookups.purs @@ -18,8 +18,7 @@ import Prelude import Contract.Monad (Contract, wrapContract) import Data.Either (Either, hush) import Data.Maybe (Maybe) -import FromData (class FromData) -import ToData (class ToData) +import IsData (class IsData) import Types.ScriptLookups ( MkUnbalancedTxError ( TypeCheckFailed @@ -67,10 +66,7 @@ import Types.ScriptLookups ) as ScriptLookups import Types.ScriptLookups (mkUnbalancedTx) as SL import Types.TxConstraints (TxConstraints) -import Types.TypedValidator - ( class DatumType - , class RedeemerType - ) +import Types.TypedValidator (class ValidatorTypes) -- | Create an `UnattachedUnbalancedTx` given `ScriptLookups` and -- | `TxConstraints`. You will probably want to use this version as it returns @@ -78,13 +74,13 @@ import Types.TypedValidator -- | a separate call. In particular, this should be called in conjuction with -- | `balanceAndSignTx`. mkUnbalancedTx - :: forall (r :: Row Type) (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => ScriptLookups.ScriptLookups a - -> TxConstraints b b + :: forall (r :: Row Type) (validator :: Type) (datum :: Type) + (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => ScriptLookups.ScriptLookups validator + -> TxConstraints redeemer datum -> Contract r ( Either ScriptLookups.MkUnbalancedTxError @@ -94,12 +90,12 @@ mkUnbalancedTx lookups = wrapContract <<< SL.mkUnbalancedTx lookups -- | Same as `mkUnbalancedTx` but hushes the error. mkUnbalancedTxM - :: forall (r :: Row Type) (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => ScriptLookups.ScriptLookups a - -> TxConstraints b b + :: forall (r :: Row Type) (validator :: Type) (datum :: Type) + (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => ScriptLookups.ScriptLookups validator + -> TxConstraints redeemer datum -> Contract r (Maybe ScriptLookups.UnattachedUnbalancedTx) mkUnbalancedTxM lookups = map hush <<< mkUnbalancedTx lookups diff --git a/src/IsData.purs b/src/IsData.purs new file mode 100644 index 0000000000..e0dfda96cd --- /dev/null +++ b/src/IsData.purs @@ -0,0 +1,9 @@ +module IsData (class IsData) where + +import FromData (class FromData) +import ToData (class ToData) + +class IsData :: Type -> Constraint +class (FromData a, ToData a) <= IsData a + +instance (FromData a, ToData a) => IsData a diff --git a/src/Types/ScriptLookups.purs b/src/Types/ScriptLookups.purs index 32ca4fce89..9d11a0ed6d 100644 --- a/src/Types/ScriptLookups.purs +++ b/src/Types/ScriptLookups.purs @@ -109,9 +109,9 @@ import Effect (Effect) import Effect.Aff (Aff) import Effect.Aff.Class (liftAff) import Effect.Class (liftEffect) -import FromData (class FromData) import Hashing (datumHash) as Hashing import Helpers ((<\>), liftEither, liftM) +import IsData (class IsData) import Plutus.Conversion (fromPlutusTxOutput, fromPlutusValue) import Plutus.Types.Transaction (TransactionOutput) as Plutus import QueryM (QueryM, QueryMExtended, getDatumByHash) @@ -132,6 +132,7 @@ import Transaction , attachRedeemer , setScriptDataHash ) +import Type.Proxy (Proxy(Proxy)) import Types.Any (Any) import Types.Datum (DataHash, Datum) import Types.Interval @@ -184,7 +185,7 @@ import Types.TypedTxOut ) import Types.TypedValidator ( class DatumType - , class RedeemerType + , class ValidatorTypes , TypedValidator(TypedValidator) ) import Types.TypedValidator (generalise) as TV @@ -486,11 +487,11 @@ type ConstraintsM (a :: Type) (b :: Type) = StateT (ConstraintProcessingState a) (QueryMExtended ()) b -- The constraints don't precisely match those of Plutus: --- `forall a. (FromData (DatumType a), ToData (DatumType a), ToData (RedeemerType a))` --- as we don't have the same granularity on the classes, but the type `a` fixes --- a type `b` as seen below. We could alternatively create specific typeclasses: --- ToData (Datumtype a) <-> (Datumtype a b, ToData b) <= ToDataDatumType a b --- if we require granular control, similarly FromDataToDatumType a b etc. +-- `forall v. (FromData (DatumType v), ToData (DatumType v), ToData (RedeemerType v))` +-- as we don't have the same granularity on the classes, but the type `v` fixes +-- types `d` and `r` as seen below. We could alternatively create specific typeclasses: +-- ToData (DatumType v) <-> (DatumType v d, ToData d) <= ToDataDatumType v d +-- if we require granular control, similarly FromDataDatumType v d etc. -- We could use `MonadError` to clean up the `ExceptT`s below although we can't -- use the type alias because they need to be fully applied so this is perhaps -- more readable. @@ -499,13 +500,12 @@ type ConstraintsM (a :: Type) (b :: Type) = -- | Resolve some `TxConstraints` by modifying the `UnbalancedTx` in the -- | `ConstraintProcessingState` processLookupsAndConstraints - :: forall (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => TxConstraints b b - -> ConstraintsM a (Either MkUnbalancedTxError Unit) + :: forall (validator :: Type) (datum :: Type) (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => TxConstraints redeemer datum + -> ConstraintsM validator (Either MkUnbalancedTxError Unit) processLookupsAndConstraints (TxConstraints { constraints, ownInputs, ownOutputs }) = runExceptT do -- Hash all the MintingPolicys and Scripts beforehand. These maps are lost @@ -527,7 +527,7 @@ processLookupsAndConstraints mintRedeemers :: Array _ <- use _mintRedeemers <#> Map.toUnfoldable lift $ traverse_ (attachToCps attachRedeemer <<< snd) mintRedeemers - ExceptT $ foldConstraints addOwnInput ownInputs + ExceptT $ foldConstraints (addOwnInput (Proxy :: Proxy datum)) ownInputs ExceptT $ foldConstraints addOwnOutput ownOutputs ExceptT addScriptDataHash ExceptT addMissingValueSpent @@ -558,18 +558,17 @@ processLookupsAndConstraints -- Helper to run the stack and get back to `QueryM`. See comments in -- `processLookupsAndConstraints` regarding constraints. runConstraintsM - :: forall (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => ScriptLookups a - -> TxConstraints b b - -> QueryM (Either MkUnbalancedTxError (ConstraintProcessingState a)) + :: forall (validator :: Type) (datum :: Type) (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => ScriptLookups validator + -> TxConstraints redeemer datum + -> QueryM (Either MkUnbalancedTxError (ConstraintProcessingState validator)) runConstraintsM lookups txConstraints = do costModels <- getProtocolParameters <#> unwrap >>> _.costModels let - initCps :: ConstraintProcessingState a + initCps :: ConstraintProcessingState validator initCps = { unbalancedTx: emptyUnbalancedTx , valueSpentBalancesInputs: @@ -584,8 +583,9 @@ runConstraintsM lookups txConstraints = do } unpackTuple - :: Either MkUnbalancedTxError Unit /\ (ConstraintProcessingState a) - -> Either MkUnbalancedTxError (ConstraintProcessingState a) + :: Either MkUnbalancedTxError Unit /\ + (ConstraintProcessingState validator) + -> Either MkUnbalancedTxError (ConstraintProcessingState validator) unpackTuple (Left err /\ _) = Left err unpackTuple (_ /\ cps) = Right cps unpackTuple <$> @@ -594,13 +594,12 @@ runConstraintsM lookups txConstraints = do -- See comments in `processLookupsAndConstraints` regarding constraints. -- | Create an `UnbalancedTx` given `ScriptLookups` and `TxConstraints`. mkUnbalancedTx' - :: forall (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => ScriptLookups a - -> TxConstraints b b + :: forall (validator :: Type) (datum :: Type) (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => ScriptLookups validator + -> TxConstraints redeemer datum -> QueryM (Either MkUnbalancedTxError UnbalancedTx) mkUnbalancedTx' scriptLookups txConstraints = runConstraintsM scriptLookups txConstraints <#> map _.unbalancedTx @@ -633,13 +632,12 @@ instance Show UnattachedUnbalancedTx where -- | the server. The `Spend` redeemers will require reindexing and all hardcoded -- | to `zero` from this function. mkUnbalancedTx - :: forall (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => ScriptLookups a - -> TxConstraints b b + :: forall (validator :: Type) (datum :: Type) (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => ScriptLookups validator + -> TxConstraints redeemer datum -> QueryM (Either MkUnbalancedTxError UnattachedUnbalancedTx) mkUnbalancedTx scriptLookups txConstraints = runConstraintsM scriptLookups txConstraints <#> map @@ -723,14 +721,14 @@ updateUtxoIndex = runExceptT do -- | Add a typed input, checking the type of the output it spends. Return the value -- | of the spent output. addOwnInput - :: forall (a :: Type) (b :: Type) - . DatumType a b - => RedeemerType a b - => FromData b - => ToData b - => InputConstraint b - -> ConstraintsM a (Either MkUnbalancedTxError Unit) -addOwnInput (InputConstraint { txOutRef }) = do + :: forall (validator :: Type) (datum :: Type) (redeemer :: Type) + . ValidatorTypes validator datum redeemer + => IsData datum + => IsData redeemer + => Proxy datum + -> InputConstraint redeemer + -> ConstraintsM validator (Either MkUnbalancedTxError Unit) +addOwnInput _pd (InputConstraint { txOutRef }) = do networkId <- getNetworkId runExceptT do ScriptLookups { txOutputs, typedValidator } <- use _lookups @@ -750,12 +748,11 @@ addOwnInput (InputConstraint { txOutRef }) = do -- | Add a typed output and return its value. addOwnOutput - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => OutputConstraint b - -> ConstraintsM a (Either MkUnbalancedTxError Unit) + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => ToData datum + => OutputConstraint datum + -> ConstraintsM validator (Either MkUnbalancedTxError Unit) addOwnOutput (OutputConstraint { datum: d, value }) = do networkId <- getNetworkId runExceptT do diff --git a/src/Types/TypedTxOut.purs b/src/Types/TypedTxOut.purs index c00ba7ec31..d5fe34f549 100644 --- a/src/Types/TypedTxOut.purs +++ b/src/Types/TypedTxOut.purs @@ -42,6 +42,7 @@ import Data.Show.Generic (genericShow) import FromData (class FromData, fromData) import Hashing (datumHash) as Hashing import Helpers (liftM) +import IsData (class IsData) import QueryM (QueryM, getDatumByHash) import Scripts (typedValidatorEnterpriseAddress) import Serialization.Address (Address, NetworkId) @@ -61,102 +62,94 @@ import Cardano.Types.Value (Value) -- | carries the address type. We don't include such a type in our setup. -- | Note that `TypedTxOut` is implicitly constrained by its smart -- | constructor. -newtype TypedTxOutRef (a :: Type) (b :: Type) = TypedTxOutRef - { txOutRef :: TransactionInput, typedTxOut :: TypedTxOut a b } +newtype TypedTxOutRef (validator :: Type) (datum :: Type) = TypedTxOutRef + { txOutRef :: TransactionInput, typedTxOut :: TypedTxOut validator datum } --- `DatumType a b` not needed but this replicates Plutus and provides extra +-- `DatumType validator datum` not needed but this replicates Plutus and provides extra -- type safety. -derive newtype instance (DatumType a b, Eq b) => Eq (TypedTxOutRef a b) +derive newtype instance + ( DatumType validator datum + , Eq datum + ) => + Eq (TypedTxOutRef validator datum) -- | Extract the `Address` of a `TypedTxOutRef` typedTxOutRefAddress - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOutRef a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOutRef validator datum -> Address typedTxOutRefAddress (TypedTxOutRef { typedTxOut }) = typedTxOutAddress typedTxOut -- | Extract the `DataHash` of a `TypedTxOutRef` typedTxOutRefDatumHash - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOutRef a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOutRef validator datum -> Maybe DataHash typedTxOutRefDatumHash (TypedTxOutRef { typedTxOut }) = typedTxOutDatumHash typedTxOut -- | Extract the `Value` of a `TypedTxOutRef` typedTxOutRefValue - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOutRef a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOutRef validator datum -> Value typedTxOutRefValue (TypedTxOutRef { typedTxOut }) = typedTxOutValue typedTxOut -- | Extract the `TransactionInput` of a `TypedTxOutRef` typedTxOutRefInput - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOutRef a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOutRef validator datum -> TransactionInput typedTxOutRefInput (TypedTxOutRef { txOutRef }) = txOutRef -- A `TransactionOutput` tagged by a phantom type: and the connection type of -- the output. DO NOT import as extra constraints are required so only import -- the smart constructor `mkTypedTxOut` -newtype TypedTxOut (a :: Type) (b :: Type) = TypedTxOut - { txOut :: TransactionOutput, data :: b } +newtype TypedTxOut (validator :: Type) (datum :: Type) = TypedTxOut + { txOut :: TransactionOutput, data :: datum } -- `DatumType a b` not needed but this replicates Plutus and provides extra -- type safety. -derive newtype instance (DatumType a b, Eq b) => Eq (TypedTxOut a b) +derive newtype instance + ( DatumType validator datum + , Eq datum + ) => + Eq (TypedTxOut validator datum) -- | Extract the `Address` of a `TypedTxOut` typedTxOutAddress - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOut a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOut validator datum -> Address typedTxOutAddress (TypedTxOut { txOut }) = (unwrap txOut).address -- | Extract the `DataHash` of a `TypedTxOut` typedTxOutDatumHash - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOut a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOut validator datum -> Maybe DataHash typedTxOutDatumHash (TypedTxOut { txOut }) = (unwrap txOut).dataHash -- | Extract the `Value` of a `TypedTxOut` typedTxOutValue - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOut a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOut validator datum -> Value typedTxOutValue (TypedTxOut { txOut }) = (unwrap txOut).amount -- | Extract the `TxOut` ~ `TransactionOutput` of a `TypedTxOut` typedTxOutTxOut - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b - => TypedTxOut a b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => TypedTxOut validator datum -> TransactionOutput typedTxOutTxOut (TypedTxOut { txOut }) = txOut @@ -167,15 +160,14 @@ typedTxOutTxOut (TypedTxOut { txOut }) = txOut -- | constructor is required because extra constraints are needed. -- | `TransactionOutput` is tagged by a phantom type. mkTypedTxOut - :: forall (a :: Type) (b :: Type) - . DatumType a b - => FromData b - => ToData b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => ToData datum => NetworkId - -> TypedValidator a - -> b + -> TypedValidator validator + -> datum -> Value - -> Maybe (TypedTxOut a b) + -> Maybe (TypedTxOut validator datum) mkTypedTxOut networkId typedVal dt amount = let mDHash = Hashing.datumHash $ Datum $ toData dt @@ -190,9 +182,9 @@ mkTypedTxOut networkId typedVal dt amount = wrap { address, amount, dataHash: pure dHash } where mkTypedTxOut' - :: b -- Data + :: datum -- Data -> TransactionOutput - -> TypedTxOut a b + -> TypedTxOut validator datum mkTypedTxOut' dat txOut = TypedTxOut { txOut, data: dat } -- | An error we can get while trying to type an existing transaction part. @@ -214,10 +206,10 @@ instance Show TypeCheckError where -- | Checks that the given validator hash is consistent with the actual validator. checkValidatorAddress - :: forall (a :: Type) (m :: Type -> Type) + :: forall (validator :: Type) (m :: Type -> Type) . Monad m => NetworkId - -> TypedValidator a + -> TypedValidator validator -> Address -> m (Either TypeCheckError Unit) checkValidatorAddress networkId typedVal actualAddr = runExceptT do @@ -240,27 +232,26 @@ checkValidatorAddress networkId typedVal actualAddr = runExceptT do -- | Checks that the given datum has the right type. checkDatum - :: forall (a :: Type) (b :: Type) (m :: Type -> Type) + :: forall (validator :: Type) (datum :: Type) (m :: Type -> Type) . Monad m - => DatumType a b - => FromData b - => TypedValidator a + => DatumType validator datum + => FromData datum + => TypedValidator validator -> Datum - -> m (Either TypeCheckError b) + -> m (Either TypeCheckError datum) checkDatum _ (Datum pd) = - runExceptT $ liftM (WrongDatumType pd) (fromData pd :: Maybe b) + runExceptT $ liftM (WrongDatumType pd) (fromData pd :: Maybe datum) -- | Create a `TypedTxOut` from an existing `TransactionInput` by -- | checking the types of its parts. typeTxOut - :: forall (a :: Type) (b :: Type) (m :: Type -> Type) - . DatumType a b - => FromData b - => ToData b + :: forall (validator :: Type) (datum :: Type) + . DatumType validator datum + => IsData datum => NetworkId - -> TypedValidator a + -> TypedValidator validator -> TransactionOutput - -> QueryM (Either TypeCheckError (TypedTxOut a b)) + -> QueryM (Either TypeCheckError (TypedTxOut validator datum)) typeTxOut networkId typedVal @@ -279,15 +270,14 @@ typeTxOut -- | against the validator script and be able to look up the `TransactionInput` to -- | which this reference points. typeTxOutRef - :: forall (a :: Type) (b :: Type) (m :: Type -> Type) - . DatumType a b - => FromData b - => ToData b + :: forall (validator :: Type) (datum :: Type) (m :: Type -> Type) + . DatumType validator datum + => IsData datum => NetworkId -> (TransactionInput -> Maybe TransactionOutput) - -> TypedValidator a + -> TypedValidator validator -> TransactionInput - -> QueryM (Either TypeCheckError (TypedTxOutRef a b)) + -> QueryM (Either TypeCheckError (TypedTxOutRef validator datum)) typeTxOutRef networkId lookupRef typedVal txOutRef = runExceptT do out <- liftM UnknownRef (lookupRef txOutRef) typedTxOut <- ExceptT $ typeTxOut networkId typedVal out diff --git a/src/Types/TypedValidator.purs b/src/Types/TypedValidator.purs index 9b7fdb3fd4..497e6da220 100644 --- a/src/Types/TypedValidator.purs +++ b/src/Types/TypedValidator.purs @@ -46,38 +46,49 @@ import Types.Scripts -- it suffices. -- | A typeclass that associates a type standing for a connection type with two -- | types, the type of the redeemer and the data script for that connection type. +class ValidatorTypes :: Type -> Type -> Type -> Constraint class - ( DatumType a b - , RedeemerType a b + ( DatumType validator datum + , RedeemerType validator redeemer ) <= - ValidatorTypes (a :: Type) (b :: Type) - | a -> b + ValidatorTypes validator datum redeemer + +instance + ( DatumType validator datum + , RedeemerType validator redeemer + ) => + ValidatorTypes validator datum redeemer -- | The type of the data of this connection type. -class DatumType (a :: Type) (b :: Type) | a -> b +class DatumType :: Type -> Type -> Constraint +class DatumType validator datum | validator -> datum instance DatumType Void Void -else instance DatumType Any PlutusData +instance DatumType Any PlutusData --- | Default instance -else instance DatumType a Unit +instance DatumType PlutusData Unit -- | The type of the redeemers of this connection type. -class RedeemerType (a :: Type) (b :: Type) | a -> b +class RedeemerType :: Type -> Type -> Constraint +class RedeemerType validator redeemer | validator -> redeemer instance RedeemerType Void Void -else instance RedeemerType Any PlutusData +instance RedeemerType Any PlutusData --- | Default instance -else instance RedeemerType a Unit +instance RedeemerType PlutusData Unit -- Replace `ScriptContext` by `Transaction` which contains all the scripts -- anyway: -- | The type of validators for the given connection type. -type ValidatorType (a :: Type) (b :: Type) = - DatumType a b => RedeemerType a b => b -> b -> Transaction -> Boolean +type ValidatorType (validator :: Type) (datum :: Type) (redeemer :: Type) = + DatumType validator datum + => RedeemerType validator redeemer + => datum + -> redeemer + -> Transaction + -> Boolean type WrappedValidatorType = PlutusData -> PlutusData -> PlutusData -> Effect Unit diff --git a/src/Wallet.js b/src/Wallet.js index c9b08aab6f..014a125325 100644 --- a/src/Wallet.js +++ b/src/Wallet.js @@ -1,13 +1,54 @@ /* global BROWSER_RUNTIME */ -exports._enableNami = () => window.cardano.nami.enable(); +const getIsWalletAvailableFunctionName = wallet => { + const strs = { + nami: "isNamiWalletAvailable", + gerowallet: "isGeroWalletAvailable", + }; -exports._enableGero = () => window.cardano.gerowallet.enable(); + return strs[wallet] || "is?WalletAvailable"; +}; -const isWalletAvailable = walletName => () => - typeof window.cardano != "undefined" && - typeof window.cardano[walletName] != "undefined" && - typeof window.cardano[walletName].enable == "function"; +const nodeEnvError = + "`window` is not an object. Are you trying to run a Contract with" + + " connected light wallet in NodeJS environment?"; + +const checkNotNode = () => { + if (typeof window != "object") { + throw nodeEnvError; + } +}; + +const enableWallet = wallet => () => { + const isAvailable = isWalletAvailable(wallet)(); + if (isAvailable) { + return window.cardano[wallet].enable().catch(e => { + throw ( + "enableWallet failed: " + + (typeof e.info == "string" ? e.info : e.toString()) + ); + }); + } else { + throw ( + "Wallet is not available. Use `" + + getIsWalletAvailableFunctionName(wallet) + + "` before connecting." + ); + } +}; + +exports._enableNami = enableWallet("nami"); + +exports._enableGero = enableWallet("gerowallet"); + +const isWalletAvailable = walletName => () => { + checkNotNode(); + return ( + typeof window.cardano != "undefined" && + typeof window.cardano[walletName] != "undefined" && + typeof window.cardano[walletName].enable == "function" + ); +}; exports._isNamiAvailable = isWalletAvailable("nami");