diff --git a/plutarch-design-pattern.cabal b/plutarch-design-pattern.cabal index 86f2217..cf4eb8a 100644 --- a/plutarch-design-pattern.cabal +++ b/plutarch-design-pattern.cabal @@ -123,6 +123,7 @@ library Plutarch.TxLevelMinter Plutarch.Utils Plutarch.ValidityRangeNormalization + Plutarch.SingularUTxOIndexerOneToMany build-depends: , aeson diff --git a/src/Plutarch/MerkelizedValidator.hs b/src/Plutarch/MerkelizedValidator.hs index 794ad5e..3090234 100644 --- a/src/Plutarch/MerkelizedValidator.hs +++ b/src/Plutarch/MerkelizedValidator.hs @@ -5,6 +5,8 @@ module Plutarch.MerkelizedValidator ( spend, withdraw, + WithdrawRedeemer (..), + PWithdrawRedeemer (..), ) where import Plutarch.Api.V1 qualified as V1 diff --git a/src/Plutarch/SingularUTxOIndexer.hs b/src/Plutarch/SingularUTxOIndexer.hs index 44fd0fb..77a4437 100644 --- a/src/Plutarch/SingularUTxOIndexer.hs +++ b/src/Plutarch/SingularUTxOIndexer.hs @@ -1,5 +1,7 @@ module Plutarch.SingularUTxOIndexer ( spend, + SpendRedeemer (..), + PSpendRedeemer (..), ) where import Plutarch.Api.V2 ( @@ -31,6 +33,7 @@ newtype PSpendRedeemer (s :: S) instance DerivePlutusType PSpendRedeemer where type DPTStrat _ = PlutusTypeData instance PTryFrom PData PSpendRedeemer + spend :: Term s (PTxOut :--> PTxOut :--> PBool) -> Term s PValidator spend f = plam $ \_datum redeemer ctx -> unTermCont $ do diff --git a/src/Plutarch/SingularUTxOIndexerOneToMany.hs b/src/Plutarch/SingularUTxOIndexerOneToMany.hs new file mode 100644 index 0000000..928c32c --- /dev/null +++ b/src/Plutarch/SingularUTxOIndexerOneToMany.hs @@ -0,0 +1,68 @@ +module Plutarch.SingularUTxOIndexerOneToMany ( + spend, + SpendRedeemer (..), + PSpendRedeemer (..), +) where + +import Plutarch.Api.V2 ( + PScriptPurpose (..), + PTxOut, + PValidator, + ) +import Plutarch.Builtin (pasInt) +import Plutarch.DataRepr (PDataFields) +import Plutarch.Prelude +import Plutarch.Unsafe (punsafeCoerce) +import PlutusTx (BuiltinData) +import "liqwid-plutarch-extra" Plutarch.Extra.TermCont ( + pletC, + pletFieldsC, + pmatchC, + ) + +data SpendRedeemer = SpendRedeemer + { inIx :: BuiltinData + , outIxs :: [BuiltinData] + } + deriving stock (Generic, Eq, Show) + +newtype PSpendRedeemer (s :: S) + = PSpendRedeemer (Term s (PDataRecord '["inIx" ':= PData, "outIxs" ':= PBuiltinList PData])) + deriving stock (Generic) + deriving anyclass (PlutusType, PIsData, PDataFields, PShow) + +instance DerivePlutusType PSpendRedeemer where type DPTStrat _ = PlutusTypeData +instance PTryFrom PData PSpendRedeemer + +spend :: Term s (PTxOut :--> PBool) + -> Term s (PTxOut :--> PTxOut :--> PBool) + -> Term s (PBuiltinList PTxOut :--> PInteger :--> PBool) + -> Term s PValidator +spend inputValidator inputOutputValidator collectiveOutputValidator = + plam $ \_datum redeemer ctx -> unTermCont $ do + let red = punsafeCoerce @_ @_ @PSpendRedeemer redeemer + redF <- pletFieldsC @'["indx", "outIxs"] red + ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx + PSpending ownRef' <- pmatchC ctxF.purpose + ownRef <- pletC $ pfield @"_0" # ownRef' + txInfoF <- pletFieldsC @'["inputs", "outputs"] ctxF.txInfo + let inIx = pasInt # redF.inIx + outIxs = pmap # pasInt # redF.outIxs + (_, outTxOuts, outputCount) = + pfoldr # + plan (\(curIdx (prevIdx, acc, count) -> pif + (curIdx #< prevIdx) + (curIdx, pconcat # acc # psingleton (pelemAt @PBuiltinList # curIdx # txInfoF.outputs), count + 1)) + perror + ) # + (P.length # outputs, [], 0) # + outIxs + + outOutput = pelemAt @PBuiltinList # outIdx # txInfoF.outputs + inInputF <- pletFieldsC @'["outRef", "resolved"] (pelemAt @PBuiltinList # inIx # txInfoF.inputs) + return $ + popaque $ + pif + (ptraceIfFalse "Indicated input must match the spending one" (ownRef #== inInputF.outRef)) + (inputOutputValidator # inInputF.resolved # outOutput) + perror