From 1ca41a29b3fbf637c2bafa0dda404032cd7064fc Mon Sep 17 00:00:00 2001 From: hade Date: Thu, 25 Apr 2024 21:09:37 +0700 Subject: [PATCH] fix: more build fixes --- plutarch-design-pattern.cabal | 2 +- src/Plutarch/SingularUTxOIndexerOneToMany.hs | 62 ++++++++++++-------- 2 files changed, 38 insertions(+), 26 deletions(-) diff --git a/plutarch-design-pattern.cabal b/plutarch-design-pattern.cabal index cf4eb8a..4b5dbd9 100644 --- a/plutarch-design-pattern.cabal +++ b/plutarch-design-pattern.cabal @@ -119,11 +119,11 @@ library exposed-modules: Plutarch.MerkelizedValidator Plutarch.SingularUTxOIndexer + Plutarch.SingularUTxOIndexerOneToMany Plutarch.StakeValidator Plutarch.TxLevelMinter Plutarch.Utils Plutarch.ValidityRangeNormalization - Plutarch.SingularUTxOIndexerOneToMany build-depends: , aeson diff --git a/src/Plutarch/SingularUTxOIndexerOneToMany.hs b/src/Plutarch/SingularUTxOIndexerOneToMany.hs index 2e3c9a0..6b97095 100644 --- a/src/Plutarch/SingularUTxOIndexerOneToMany.hs +++ b/src/Plutarch/SingularUTxOIndexerOneToMany.hs @@ -8,6 +8,7 @@ module Plutarch.SingularUTxOIndexerOneToMany ( import Plutarch.Api.V2 ( PScriptPurpose (..), + PTxInInfo, PTxOut, PValidator, ) @@ -42,10 +43,11 @@ data PMyAggregator (s :: S) = PMyAggregator (Term s PInteger) (Term s (PList PTx instance DerivePlutusType PMyAggregator where type DPTStrat _ = PlutusTypeScott -spend :: Term s (PTxOut :--> PBool) - -> Term s (PTxOut :--> PTxOut :--> PBool) - -> Term s (PBuiltinList PTxOut :--> PInteger :--> PBool) - -> Term s PValidator +spend :: + Term s (PTxInInfo :--> PBool) -> + Term s (PTxOut :--> PTxOut :--> PBool) -> + Term s (PList PTxOut :--> PInteger :--> PBool) -> + Term s PValidator spend inputValidator inputOutputValidator collectiveOutputValidator = plam $ \_datum redeemer ctx -> unTermCont $ do let red = punsafeCoerce @_ @_ @PSpendRedeemer redeemer @@ -54,27 +56,37 @@ spend inputValidator inputOutputValidator collectiveOutputValidator = 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 + let input = pelemAt @PBuiltinList # (pasInt # redF.inIx) # txInfoF.inputs + inInputF <- pletFieldsC @'["outRef", "resolved"] input + let outIxs = pmap # pasInt # redF.outIxs aggregated = - pfoldr # - (plam $ \curIdx p -> - pmatch p $ \case - PMyAggregator prevIdx acc count -> - pif - (curIdx #< prevIdx) - (pcon (PMyAggregator curIdx (pconcat # acc #$ psingleton # (pelemAt @PBuiltinList # curIdx # txInfoF.outputs)) (count + 1))) - perror - ) - # pcon (PMyAggregator (plength # txInfoF.outputs) pnil 0) # outIxs + pfoldr + # plam + $ \curIdx p -> + pmatch p $ + \case + PMyAggregator prevIdx acc count -> do + pif + (curIdx #< prevIdx) + ( P.do + let outOutput = pelemAt @PBuiltinList # curIdx # txInfoF.outputs + pif + (ptraceIfFalse "Input Output Validator Fails" (inputOutputValidator # inInputF.resolved # outOutput)) + (pcon (PMyAggregator curIdx (pconcat # acc #$ psingleton # (pelemAt @PBuiltinList # curIdx # txInfoF.outputs)) (count + 1))) + perror + ) + perror + _ -> perror + # pcon (PMyAggregator (plength # txInfoF.outputs) pnil 0) + # outIxs return $ pmatch aggregated $ \case - PMyAggregator _ outTxOuts outputCount -> unTermCont $ do - let outOutput = pelemAt @PBuiltinList # outIxs # 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 + PMyAggregator _ outTxOuts outputCount -> unTermCont $ do + return $ + popaque $ + pif + ( ptraceIfFalse "Indicated input must match the spending one" (ownRef #== inInputF.outRef) + #&& ptraceIfFalse "Input Validator Fails" (inputValidator # input) + ) + (collectiveOutputValidator # outTxOuts # outputCount) + perror