modify offchain and onchain code to support authentication of programmable assets in registration

Author: colll78

cabal.project

@@ -57,8 +57,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/Plutonomicon/plutarch-plutus
-    tag: 7002ce59642daa3fff9c720cf3076844ac81ac26
-    --sha256: sha256-9FR+VOUCyA0/0oHqV/m6fUXBprD9AIgrUZU0jD3f9hQ=
+    tag: f84a46287b06f36abf8d2d63bec7ff75d32f3e91
+    --sha256: sha256-gKBk9D6DHSEudq7P9+07yXWcgM/QX7NFp0tJXBodopM=
     subdir:
       .
       plutarch-ledger-api
@@ -68,8 +68,8 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/input-output-hk/catalyst-onchain-libs
-    tag: 0b997ba7e62ee5c9aa41212d24f44553410f57d7
-    --sha256: sha256-vaUFPrR8RFhEGgXbO1npwo5uSK1jRtKtg+FEVbEGuV0=
+    tag: eb9c01f177b7f1e3d2d698fefb8207f0596d941e
+    --sha256: sha256-99J5g+prx1r6qp1K3EqNRj20fc+kKM2tpxZfPYK2MqQ=
     subdir:
       src/plutarch-onchain-lib
 

src/programmable-tokens/lib/SmartTokens/Contracts/ExampleTransferLogic.hs

@@ -25,7 +25,6 @@ import Plutarch.Core.Value
 import Plutarch.LedgerApi.V3
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Repr.Data
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusTx qualified
 import SmartTokens.Types.PTokenDirectory
@@ -149,11 +148,6 @@ pextractRequiredWitnesses = phoistAcyclic $ plam $ \progBaseCred inputs ->
   )
   # pnil
   # inputs
-  where
-    paddressStakingCredential :: Term s PAddress -> Term s PStakingCredential
-    paddressStakingCredential addr =
-      pmatch addr $ \addr' ->
-        punsafeCoerce $ phead # (psndBuiltin # (pasConstr # pforgetData (pdata $ paddress'stakingCredential addr')))
 
 {-|
   The 'mkFreezeAndSeizeTransfer' is a transfer logic script that allows the associated programmable token

src/programmable-tokens/lib/SmartTokens/Contracts/IssuanceCborHex.hs

@@ -19,7 +19,6 @@ import Plutarch.Core.Value
 import Plutarch.LedgerApi.V3
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Repr.Data
 import PlutusLedgerApi.V3 (BuiltinByteString)
 import PlutusTx qualified
 import PlutusTx.Builtins.Internal qualified as BI

src/programmable-tokens/lib/SmartTokens/Contracts/ProgrammableLogicBase.hs

@@ -31,7 +31,6 @@ import Plutarch.Internal.Lift
 import Plutarch.LedgerApi.V3
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Repr.Data
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V1.Value (Value)
 import PlutusTx qualified

src/programmable-tokens/lib/SmartTokens/Contracts/ProtocolParams.hs

@@ -10,6 +10,7 @@ module SmartTokens.Contracts.ProtocolParams (
 
 import Plutarch.Core.Context
 import Plutarch.Core.List
+import Plutarch.Core.Trace (pdebug)
 import Plutarch.Core.Utils
 import Plutarch.Core.ValidationLogic
 import Plutarch.Core.Value
@@ -34,9 +35,9 @@ mkProtocolParametersMinting = plam $ \oref ctx -> P.do
   ownTokenName <- plet (pfstBuiltin # ownTkPair)
   ownNumMinted <- plet (psndBuiltin # ownTkPair)
   pvalidateConditions
-    [ ownTokenName #== pprotocolParamsTokenData
-    , ownNumMinted #== pconstant 1
-    , phasUTxO # pfromData oref # pfromData ptxInfo'inputs
+    [ pdebug "minted tn must match protocolParamsToken" $ ownTokenName #== pprotocolParamsTokenData
+    , pdebug "only single pp token must be minted" $ ownNumMinted #== pconstant 1
+    , pdebug "must spent ppInitTxOutRef" $ phasUTxO # pfromData oref # pfromData ptxInfo'inputs
     ]
 
 -- | Permissioned Minting Policy

src/programmable-tokens/lib/SmartTokens/Core/Scripts.hs

@@ -12,7 +12,7 @@ module SmartTokens.Core.Scripts (
 import Data.Aeson (FromJSON, ToJSON)
 import GHC.Generics (Generic)
 import Plutarch.Internal.Term (ClosedTerm, Config (..), LogLevel (LogInfo),
-                               Script, TracingMode (DoTracingAndBinds), compile)
+                               Script, TracingMode (..), compile)
 
 {-| Script target environment
 -}
@@ -26,7 +26,7 @@ data ScriptTarget
 -}
 targetConfig :: ScriptTarget -> Config
 targetConfig = \case
-  Debug      -> tracingAndBindsConfig
+  Debug      -> _tracingConfig
   Production -> prodConfig
 
 tryCompile :: ScriptTarget -> ClosedTerm a -> Script
@@ -40,8 +40,11 @@ tryCompileTracingAndBinds = tryCompile Debug
 tryCompileNoTracing :: ClosedTerm a -> Script
 tryCompileNoTracing = tryCompile Production
 
-tracingAndBindsConfig :: Config
-tracingAndBindsConfig = Tracing LogInfo DoTracingAndBinds
+_tracingAndBindsConfig :: Config
+_tracingAndBindsConfig = Tracing LogInfo DoTracingAndBinds
+
+_tracingConfig :: Config
+_tracingConfig = Tracing LogInfo DoTracing
 
 prodConfig :: Config
 prodConfig = NoTracing

src/programmable-tokens/lib/SmartTokens/LinkedList/Common.hs

@@ -20,6 +20,7 @@ import Plutarch.Builtin.ByteString (pintegerToByteString, pmostSignificantFirst)
 import Plutarch.Builtin.Crypto (pblake2b_224)
 import Plutarch.Core.Context
 import Plutarch.Core.List
+import Plutarch.Core.Trace (pdebug)
 import Plutarch.Core.Utils
 import Plutarch.Core.Value
 import Plutarch.Evaluate (unsafeEvalTerm)
@@ -187,7 +188,7 @@ pInsert ::
   forall (s :: S).
   Term s (PAsData PCurrencySymbol) ->
   PDirectoryCommon s ->
-  Term s (PByteString :--> PByteString :--> PUnit)
+  Term s (PByteString :--> PAsData PByteString :--> PUnit)
 pInsert issuanceCborHexCS common = plam $ \keyToInsert hashedParam -> P.do
   let issuanceCborHexUTxO =
         ptxInInfoResolved $ pfromData $
@@ -199,6 +200,11 @@ pInsert issuanceCborHexCS common = plam $ \keyToInsert hashedParam -> P.do
             # common.referenceInputs
   POutputDatum issuanceDat' <- pmatch $ ptxOutDatum issuanceCborHexUTxO
   PIssuanceCborHex {pprefixCborHex, ppostfixCborHex} <- pmatch (pfromData $ punsafeCoerce @(PAsData PIssuanceCborHex) (pto issuanceDat'))
+  ptraceInfo $ "Prefix Script" <> (pshow $ pfromData pprefixCborHex)
+  ptraceInfo $ "Hashed Param" <> (pshow $ pserialiseData # pforgetData hashedParam)
+  ptraceInfo $ "Postfix Script" <> (pshow $ pfromData ppostfixCborHex)
+  ptraceInfo $ "Key to insert" <> (pshow keyToInsert)
+  ptraceInfo $ "Computed CS: " <> (pshow $ _papplyHashedParameter (pfromData pprefixCborHex) (pfromData ppostfixCborHex) hashedParam)
   passert "Registry Entry must be valid programmable asset" $ _pisProgrammableTokenRegistration keyToInsert (pfromData pprefixCborHex) (pfromData ppostfixCborHex) hashedParam common.mint
   passert "Key to insert must be valid Currency Symbol" $ ptraceInfoIfFalse (pshow keyToInsert) $ plengthBS # keyToInsert #== 28
 
@@ -247,26 +253,26 @@ data PDirectoryCommon (s :: S) = MkCommon
   }
   deriving stock (Generic)
 
-_pisProgrammableTokenRegistration :: Term s PByteString -> Term s PByteString -> Term s PByteString -> Term s PByteString -> Term s (PValue 'Sorted 'NonZero) -> Term s PBool
+_pisProgrammableTokenRegistration :: Term s PByteString -> Term s PByteString -> Term s PByteString -> Term s (PAsData PByteString) -> Term s (PValue 'Sorted 'NonZero) -> Term s PBool
 _pisProgrammableTokenRegistration csToInsert prefixScriptBytes postfixScriptBytes hashedParam mintValue =
   pand'List
-    [ phasCS # mintValue # (pcon $ PCurrencySymbol csToInsert)
+    [ pdebug "must mint registered token" $ phasCS # mintValue # pcon (PCurrencySymbol csToInsert)
     , _papplyHashedParameter prefixScriptBytes postfixScriptBytes hashedParam #== csToInsert
     ]
 
 _papplyHashedParameter ::
   Term s PByteString
   -> Term s PByteString
-  -> Term s PByteString
+  -> Term s (PAsData PByteString)
   -> Term s PByteString
 _papplyHashedParameter prefix postfix hashedParam =
   pblake2b_224 # (scriptHeader <> postfix)
   where
-    versionHeader :: Term s PByteString
-    versionHeader = unsafeEvalTerm NoTracing (pintegerToByteString # pmostSignificantFirst # 1 # plutusVersion)
+    _versionHeader :: Term s PByteString
+    _versionHeader = unsafeEvalTerm NoTracing (pintegerToByteString # pmostSignificantFirst # 1 # _plutusVersion)
 
-    plutusVersion :: Term s PInteger
-    plutusVersion = pconstant 3
+    _plutusVersion :: Term s PInteger
+    _plutusVersion = pconstant 3
 
     scriptHeader :: Term _ PByteString
-    scriptHeader = versionHeader <> prefix <> hashedParam
+    scriptHeader = _versionHeader <> prefix <> (pserialiseData # pforgetData hashedParam)

src/programmable-tokens/lib/SmartTokens/LinkedList/MintBlacklist.hs

@@ -32,7 +32,6 @@ import Plutarch.LedgerApi.V3 (PPubKeyHash, PScriptContext (..), PTxInfo (..),
                               PTxOutRef)
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Repr.Data
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V3 (PubKeyHash)
 import PlutusTx qualified

src/programmable-tokens/lib/SmartTokens/LinkedList/MintDirectory.hs

@@ -30,7 +30,6 @@ import Plutarch.LedgerApi.V3 (PCurrencySymbol, PScriptContext (..),
                               PTxInfo (..), PTxOutRef)
 import Plutarch.Monadic qualified as P
 import Plutarch.Prelude
-import Plutarch.Repr.Data
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V3 (CurrencySymbol, ScriptHash)
 import PlutusTx qualified
@@ -80,4 +79,4 @@ mkDirectoryNodeMP = plam $ \initUTxO issuanceCborHexCS ctx -> P.do
       pInit common
     PInsert action hashedParam -> P.do
       pkToInsert <- plet action
-      pInsert issuanceCborHexCS common # pfromData pkToInsert # pfromData hashedParam
+      pInsert issuanceCborHexCS common # pfromData pkToInsert # hashedParam

src/programmable-tokens/lib/SmartTokens/Types/PTokenDirectory.hs

@@ -40,7 +40,6 @@ import Plutarch.Internal.Lift
 import Plutarch.Internal.Term (Config (NoTracing))
 import Plutarch.LedgerApi.V3 (PCredential, PCurrencySymbol)
 import Plutarch.Prelude
-import Plutarch.Repr.Data
 import Plutarch.Unsafe (punsafeCoerce)
 import PlutusLedgerApi.V3 (BuiltinByteString, Credential, CurrencySymbol)
 import PlutusTx (Data (B, Constr))