From 305be8b58ee3086b6cfee6fbacee67574f7b2110 Mon Sep 17 00:00:00 2001 From: Mark Petruska Date: Thu, 25 Apr 2024 14:47:39 +0200 Subject: [PATCH] fix: Add some build fixes --- src/Plutarch/SingularUTxOIndexerOneToMany.hs | 48 ++++++++++++-------- 1 file changed, 30 insertions(+), 18 deletions(-) diff --git a/src/Plutarch/SingularUTxOIndexerOneToMany.hs b/src/Plutarch/SingularUTxOIndexerOneToMany.hs index 928c32c..2e3c9a0 100644 --- a/src/Plutarch/SingularUTxOIndexerOneToMany.hs +++ b/src/Plutarch/SingularUTxOIndexerOneToMany.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedRecordDot #-} + module Plutarch.SingularUTxOIndexerOneToMany ( spend, SpendRedeemer (..), @@ -34,35 +36,45 @@ newtype PSpendRedeemer (s :: S) instance DerivePlutusType PSpendRedeemer where type DPTStrat _ = PlutusTypeData instance PTryFrom PData PSpendRedeemer -spend :: Term s (PTxOut :--> PBool) +data PMyAggregator (s :: S) = PMyAggregator (Term s PInteger) (Term s (PList PTxOut)) (Term s PInteger) + deriving stock (Generic) + deriving anyclass (PlutusType, PEq, PShow) + +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 inputValidator inputOutputValidator collectiveOutputValidator = plam $ \_datum redeemer ctx -> unTermCont $ do let red = punsafeCoerce @_ @_ @PSpendRedeemer redeemer - redF <- pletFieldsC @'["indx", "outIxs"] red + redF <- pletFieldsC @'["inIx", "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) = + aggregated = 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 + (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 - 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 + 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