Merge pull request #17 from Liqwid-Labs/jhodgdev/plutarch-bump

jhodgdev/plutarch bump

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:

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,
+        "lastModified": 1643303963,
-        "narHash": "sha256-wLWcjeuGUcH8rYz/LXIxUTO/Wnfvq/5GBS55cqof6nE=",
+        "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",

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";

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.Api.V1
-import Plutarch.Bool (PBool, PEq, pif, (#<), (#==))
+import Plutarch.List (pfoldr')
-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)
-import Plutarch.Maybe (PMaybe (PJust, PNothing))
 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.
+{- | An AuthorityToken represents a proof that a particular token
- In effect, this means that the validator that locked such a token must have approved said transaction.
+     moved while this token was minted. In effect, this means that
- Said validator should be made aware of _this_ token's existence in order to prevent incorrect minting.
+     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.
@@ -50,14 +47,19 @@ data AuthorityToken = AuthorityToken
 --------------------------------------------------------------------------------
 
 -- 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 ->
@@ -69,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'' ->
@@ -83,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
@@ -93,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' =
+      let txInfo' = pfromData $ pfield @"txInfo" # ctx
-            pfromData $ pindexDataList (Proxy @0) # ctx
+          purpose' = pfromData $ pfield @"purpose" # ctx
-
-          purpose' =
-            pfromData $ pindexDataList (Proxy @1) # 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
+                    let txOut' =
-                        txOutValue = pmatch txOut' $ \(PTxOut txOut) -> pfromData $ pindexDataList (Proxy @1) # txOut
+                          pfromData $ pfield @"resolved" # txInInfo
+                        txOutValue =
+                          pmatch txOut' $
+                            \(PTxOut txOut) ->
+                              pfromData $ pfield @"value" # txOut
                      in passetClassValueOf' params.authority # txOutValue + acc
               )
               # (0 :: Term s PInteger)
@@ -121,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)