From 53ca5437d968beeafb3647bbec78106f4ca07c3f Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 28 Jan 2022 12:12:41 +0000 Subject: [PATCH 1/4] Updated ref to plutarch --- flake.lock | 31 ++++++++++++++++++++++++------- flake.nix | 2 +- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/flake.lock b/flake.lock index 8312ec8..cb2c99d 100644 --- a/flake.lock +++ b/flake.lock @@ -710,6 +710,22 @@ } }, "haskell-language-server": { + "flake": false, + "locked": { + "lastModified": 1643360816, + "narHash": "sha256-M4noTbTGa7oYfg2/8NqDugGX/qs8j//gJUiLwuPU9Co=", + "owner": "haskell", + "repo": "haskell-language-server", + "rev": "ce41b6459af131c845f942bd39e356f02b6306fa", + "type": "github" + }, + "original": { + "owner": "haskell", + "repo": "haskell-language-server", + "type": "github" + } + }, + "haskell-language-server_2": { "flake": false, "locked": { "lastModified": 1638136578, @@ -726,7 +742,7 @@ "type": "github" } }, - "haskell-language-server_2": { + "haskell-language-server_3": { "flake": false, "locked": { "lastModified": 1638136578, @@ -1363,6 +1379,7 @@ "flake-compat-ci": "flake-compat-ci", "flat": "flat_2", "foundation": "foundation", + "haskell-language-server": "haskell-language-server", "haskell-nix": "haskell-nix_2", "hercules-ci-effects": "hercules-ci-effects", "hs-memory": "hs-memory", @@ -1376,17 +1393,17 @@ "th-extras": "th-extras" }, "locked": { - "lastModified": 1642778520, - "narHash": "sha256-wLWcjeuGUcH8rYz/LXIxUTO/Wnfvq/5GBS55cqof6nE=", + "lastModified": 1643303963, + "narHash": "sha256-Ta3PLyLX209Dj1LWljkp9ynlA+QPJyaI2g6oQgBeueM=", "owner": "Plutonomicon", "repo": "plutarch", - "rev": "d845c2ad3292d141b61024dc24c9ab305540dc98", + "rev": "d753dc34dfc30b144e94d6493c837ebd0c99b588", "type": "github" }, "original": { "owner": "Plutonomicon", "repo": "plutarch", - "rev": "d845c2ad3292d141b61024dc24c9ab305540dc98", + "rev": "d753dc34dfc30b144e94d6493c837ebd0c99b588", "type": "github" } }, @@ -1395,7 +1412,7 @@ "cardano-repo-tool": "cardano-repo-tool", "gitignore-nix": "gitignore-nix", "hackage-nix": "hackage-nix", - "haskell-language-server": "haskell-language-server", + "haskell-language-server": "haskell-language-server_2", "haskell-nix": "haskell-nix_3", "iohk-nix": "iohk-nix", "nixpkgs": "nixpkgs_3", @@ -1440,7 +1457,7 @@ "cardano-repo-tool": "cardano-repo-tool_2", "gitignore-nix": "gitignore-nix_2", "hackage-nix": "hackage-nix_2", - "haskell-language-server": "haskell-language-server_2", + "haskell-language-server": "haskell-language-server_3", "haskell-nix": "haskell-nix_4", "iohk-nix": "iohk-nix_2", "nixpkgs": "nixpkgs_4", diff --git a/flake.nix b/flake.nix index b1cdb6a..ae7ec49 100644 --- a/flake.nix +++ b/flake.nix @@ -10,7 +10,7 @@ "github:input-output-hk/plutus?rev=65bad0fd53e432974c3c203b1b1999161b6c2dce"; inputs.plutarch.url = - "github:Plutonomicon/plutarch?rev=d845c2ad3292d141b61024dc24c9ab305540dc98"; + "github:Plutonomicon/plutarch?rev=d753dc34dfc30b144e94d6493c837ebd0c99b588"; inputs.goblins.url = "github:input-output-hk/goblins?rev=cde90a2b27f79187ca8310b6549331e59595e7ba"; From 7a4cb8276de410b083545cfac8357ec410b46c4f Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Fri, 28 Jan 2022 14:01:50 +0000 Subject: [PATCH 2/4] adding dummy function for pindex --- src/Agora/AuthorityToken.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs index 477c8e8..8f70eae 100644 --- a/src/Agora/AuthorityToken.hs +++ b/src/Agora/AuthorityToken.hs @@ -27,7 +27,6 @@ import Plutus.V1.Ledger.Value (AssetClass (..)) import Plutarch.Api.V1 hiding (PMaybe (..)) import Plutarch.Bool (PBool, PEq, pif, (#<), (#==)) import Plutarch.Builtin (PBuiltinPair, PData, pdata, pfromData, pfstBuiltin, psndBuiltin) -import Plutarch.DataRepr (pindexDataList) import Plutarch.Integer (PInteger) import Plutarch.Lift (pconstant) import Plutarch.List (PIsListLike, pfoldr', precList) @@ -49,6 +48,8 @@ data AuthorityToken = AuthorityToken -------------------------------------------------------------------------------- +pindexDataList = undefined + -- TODO: upstream something like this pfind' :: PIsListLike list a => (Term s a -> Term s PBool) -> Term s (list a :--> PMaybe a) pfind' p = From ae03f77a2321aa68aeaff614d66a684b34bb5143 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Tue, 1 Feb 2022 12:11:33 +0000 Subject: [PATCH 3/4] . --- src/Agora/AuthorityToken.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs index 8f70eae..b56f434 100644 --- a/src/Agora/AuthorityToken.hs +++ b/src/Agora/AuthorityToken.hs @@ -27,6 +27,7 @@ import Plutus.V1.Ledger.Value (AssetClass (..)) import Plutarch.Api.V1 hiding (PMaybe (..)) import Plutarch.Bool (PBool, PEq, pif, (#<), (#==)) import Plutarch.Builtin (PBuiltinPair, PData, pdata, pfromData, pfstBuiltin, psndBuiltin) +import Plutarch.DataRepr.Internal.HList (IndexList) import Plutarch.Integer (PInteger) import Plutarch.Lift (pconstant) import Plutarch.List (PIsListLike, pfoldr', precList) @@ -48,6 +49,7 @@ data AuthorityToken = AuthorityToken -------------------------------------------------------------------------------- +pindexDataList :: Proxy n -> Term s (PDataList xs :--> PAsData (IndexList n xs)) pindexDataList = undefined -- TODO: upstream something like this From 5e7233829ffcccab14ff8496f97fa139c3cc83e6 Mon Sep 17 00:00:00 2001 From: Jack Hodgkinson <30505104+jhodgdev@users.noreply.github.com> Date: Tue, 1 Feb 2022 16:11:03 +0000 Subject: [PATCH 4/4] Removed references to pindexdatalist in AuthorityToken --- Makefile | 2 +- src/Agora/AuthorityToken.hs | 70 ++++++++++++++++++++----------------- 2 files changed, 38 insertions(+), 34 deletions(-) diff --git a/Makefile b/Makefile index 5b30a16..84c1ed3 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ usage: HOOGLE_PORT=8081 hoogle: - hoogle server --local --port $(HOOGLE_PORT) + hoogle server --local --port $(HOOGLE_PORT) > /dev/null & FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -fplugin=RecordDotPreprocessor format: diff --git a/src/Agora/AuthorityToken.hs b/src/Agora/AuthorityToken.hs index b56f434..22d43f3 100644 --- a/src/Agora/AuthorityToken.hs +++ b/src/Agora/AuthorityToken.hs @@ -1,8 +1,11 @@ -module Agora.AuthorityToken (authorityTokenPolicy, AuthorityToken (..), serialisedScriptSize) where +module Agora.AuthorityToken ( + authorityTokenPolicy, + AuthorityToken (..), + serialisedScriptSize, +) where -------------------------------------------------------------------------------- -import Data.Proxy (Proxy (..)) import Prelude -------------------------------------------------------------------------------- @@ -24,23 +27,17 @@ import Plutus.V1.Ledger.Value (AssetClass (..)) -------------------------------------------------------------------------------- -import Plutarch.Api.V1 hiding (PMaybe (..)) -import Plutarch.Bool (PBool, PEq, pif, (#<), (#==)) -import Plutarch.Builtin (PBuiltinPair, PData, pdata, pfromData, pfstBuiltin, psndBuiltin) -import Plutarch.DataRepr.Internal.HList (IndexList) -import Plutarch.Integer (PInteger) -import Plutarch.Lift (pconstant) -import Plutarch.List (PIsListLike, pfoldr', precList) -import Plutarch.Maybe (PMaybe (PJust, PNothing)) +import Plutarch.Api.V1 +import Plutarch.List (pfoldr') import Plutarch.Prelude -import Plutarch.Trace (ptraceError) -import Plutarch.Unit (PUnit) -------------------------------------------------------------------------------- -{- | An AuthorityToken represents a proof that a particular token moved while this token was minted. - In effect, this means that the validator that locked such a token must have approved said transaction. - Said validator should be made aware of _this_ token's existence in order to prevent incorrect minting. +{- | An AuthorityToken represents a proof that a particular token + moved while this token was minted. In effect, this means that + the validator that locked such a token must have approved + said transaction. Said validator should be made aware of + _this_ token's existence in order to prevent incorrect minting. -} data AuthorityToken = AuthorityToken { -- | Token that must move in order for minting this to be valid. @@ -49,18 +46,20 @@ data AuthorityToken = AuthorityToken -------------------------------------------------------------------------------- -pindexDataList :: Proxy n -> Term s (PDataList xs :--> PAsData (IndexList n xs)) -pindexDataList = undefined - -- TODO: upstream something like this -pfind' :: PIsListLike list a => (Term s a -> Term s PBool) -> Term s (list a :--> PMaybe a) +pfind' :: + PIsListLike list a => + (Term s a -> Term s PBool) -> + Term s (list a :--> PMaybe a) pfind' p = precList (\self x xs -> pif (p x) (pcon (PJust x)) (self # xs)) (const $ pcon PNothing) -- TODO: upstream something like this -plookup :: (PEq a, PIsListLike list (PBuiltinPair a b)) => Term s (a :--> list (PBuiltinPair a b) :--> PMaybe b) +plookup :: + (PEq a, PIsListLike list (PBuiltinPair a b)) => + Term s (a :--> list (PBuiltinPair a b) :--> PMaybe b) plookup = phoistAcyclic $ plam $ \k xs -> @@ -72,7 +71,8 @@ passetClassValueOf' :: AssetClass -> Term s (PValue :--> PInteger) passetClassValueOf' (AssetClass (sym, token)) = passetClassValueOf # pconstant sym # pconstant token -passetClassValueOf :: Term s (PCurrencySymbol :--> PTokenName :--> PValue :--> PInteger) +passetClassValueOf :: + Term s (PCurrencySymbol :--> PTokenName :--> PValue :--> PInteger) passetClassValueOf = phoistAcyclic $ plam $ \sym token value'' -> @@ -86,7 +86,8 @@ passetClassValueOf = PNothing -> 0 PJust v -> pfromData v --- TODO: We should rely on plutus-extra instead of rolling our own, this is just quick & hacky. +-- TODO: We should rely on plutus-extra instead of rolling our own, +-- this is just quick and hacky. serialisedScriptSize :: Script -> Int serialisedScriptSize = BSS.length @@ -96,26 +97,29 @@ serialisedScriptSize = . BS.toStrict . serialise -authorityTokenPolicy :: AuthorityToken -> Term s (PData :--> PData :--> PScriptContext :--> PUnit) +authorityTokenPolicy :: + AuthorityToken -> + Term s (PData :--> PData :--> PScriptContext :--> PUnit) authorityTokenPolicy params = plam $ \_datum _redeemer ctx' -> pmatch ctx' $ \(PScriptContext ctx) -> - let txInfo' = - pfromData $ pindexDataList (Proxy @0) # ctx - - purpose' = - pfromData $ pindexDataList (Proxy @1) # ctx + let txInfo' = pfromData $ pfield @"txInfo" # ctx + purpose' = pfromData $ pfield @"purpose" # ctx inputs = pmatch txInfo' $ \(PTxInfo txInfo) -> - pfromData $ pindexDataList (Proxy @0) # txInfo + pfromData $ pfield @"inputs" # txInfo authorityTokenInputs = pfoldr' ( \txInInfo' acc -> pmatch (pfromData txInInfo') $ \(PTxInInfo txInInfo) -> - let txOut' = pfromData $ pindexDataList (Proxy @1) # txInInfo - txOutValue = pmatch txOut' $ \(PTxOut txOut) -> pfromData $ pindexDataList (Proxy @1) # txOut + let txOut' = + pfromData $ pfield @"resolved" # txInInfo + txOutValue = + pmatch txOut' $ + \(PTxOut txOut) -> + pfromData $ pfield @"value" # txOut in passetClassValueOf' params.authority # txOutValue + acc ) # (0 :: Term s PInteger) @@ -124,12 +128,12 @@ authorityTokenPolicy params = -- We incur the cost twice here. This will be fixed upstream in Plutarch. mintedValue = pmatch txInfo' $ \(PTxInfo txInfo) -> - pfromData $ pindexDataList (Proxy @3) # txInfo + pfromData $ pfield @"mint" # txInfo tokenMoved = 0 #< authorityTokenInputs in pmatch purpose' $ \case PMinting sym' -> - let sym = pfromData $ pindexDataList (Proxy @0) # sym' + let sym = pfromData $ pfield @"_0" # sym' mintedATs = passetClassValueOf # sym # pconstant "" # mintedValue in pif (0 #< mintedATs)