From cb45b5255be5e2266c547d7174d6a98cceb34b7b Mon Sep 17 00:00:00 2001 From: Hongrui Fang Date: Wed, 17 Aug 2022 21:58:45 +0800 Subject: [PATCH] use utils from LPE --- agora/Agora/Effect/GovernorMutation.hs | 5 +- agora/Agora/Effect/NoOp.hs | 1 + agora/Agora/Governor/Scripts.hs | 21 ++-- agora/Agora/Plutarch/Orphans.hs | 51 -------- agora/Agora/Proposal.hs | 1 + agora/Agora/Proposal/Scripts.hs | 10 +- agora/Agora/Stake.hs | 1 + agora/Agora/Stake/Scripts.hs | 17 +-- agora/Agora/Utils.hs | 154 ------------------------- 9 files changed, 29 insertions(+), 232 deletions(-) diff --git a/agora/Agora/Effect/GovernorMutation.hs b/agora/Agora/Effect/GovernorMutation.hs index 26a1c16..f3a9eba 100644 --- a/agora/Agora/Effect/GovernorMutation.hs +++ b/agora/Agora/Effect/GovernorMutation.hs @@ -26,7 +26,6 @@ import Agora.Governor ( ) import Agora.Plutarch.Orphans () import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass) -import Agora.Utils (pmustFindDatum) import Plutarch.Api.V1 (PValue) import Plutarch.Api.V2 ( PTxOutRef, @@ -39,7 +38,7 @@ import Plutarch.DataRepr ( import Plutarch.Extra.Maybe ( passertPJust, ) -import Plutarch.Extra.ScriptContext (pisScriptAddress) +import Plutarch.Extra.ScriptContext (pfromOutputDatum, pisScriptAddress) import Plutarch.Extra.TermCont (pguardC, pletFieldsC) import Plutarch.Extra.Value (pvalueOf) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) @@ -201,7 +200,7 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $ let governorOutputDatum = ptrace "Governor output datum not found" $ - pmustFindDatum @PGovernorDatum # govOutput.datum # txInfoF.datums + pfromOutputDatum @PGovernorDatum # govOutput.datum # txInfoF.datums -- Ensure the output governor datum is what we want. pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum diff --git a/agora/Agora/Effect/NoOp.hs b/agora/Agora/Effect/NoOp.hs index f5db8a5..ac9952d 100644 --- a/agora/Agora/Effect/NoOp.hs +++ b/agora/Agora/Effect/NoOp.hs @@ -10,6 +10,7 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where import Agora.Effect (makeEffect) import Agora.Plutarch.Orphans () import Plutarch.Api.V2 (PValidator) +import Plutarch.Orphans () import PlutusLedgerApi.V1.Value (CurrencySymbol) {- | Dummy datum for NoOp effect. diff --git a/agora/Agora/Governor/Scripts.hs b/agora/Agora/Governor/Scripts.hs index 3957821..44bfed1 100644 --- a/agora/Agora/Governor/Scripts.hs +++ b/agora/Agora/Governor/Scripts.hs @@ -51,11 +51,6 @@ import Agora.Stake ( pnumCreatedProposals, ) import Agora.Utils ( - pfindDatum, - pfromDatumHash, - pfstTuple, - pmustFindDatum, - psndTuple, validatorHashToAddress, ) import Plutarch.Api.V1 ( @@ -81,11 +76,15 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.ScriptContext ( pfindOutputsToAddress, pfindTxInByTxOutRef, + pfromDatumHash, + pfromOutputDatum, pisUTXOSpent, pscriptHashFromAddress, + ptryFromOutputDatum, pvalueSpent, ) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) +import Plutarch.Extra.Tuple (pfstTuple, psndTuple) import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf) import PlutusLedgerApi.V1 (TxOutRef) @@ -148,7 +147,7 @@ governorPolicy initialSpend = # pfromData txInfoF.outputs let outputDatum = pfield @"datum" # govOutput - datum = pmustFindDatum @PGovernorDatum # outputDatum # txInfoF.datums + datum = pfromOutputDatum @PGovernorDatum # outputDatum # txInfoF.datums pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum @@ -279,7 +278,7 @@ governorValidator as = -- Check that own output have datum of type 'GovernorDatum'. newGovernorDatum <- - pletC $ pmustFindDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums + pletC $ pfromOutputDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum @@ -328,7 +327,7 @@ governorValidator as = stakeInputF <- pletFieldsC @'["datum", "value"] $ pfield @"resolved" # stakeInput - let stakeInputDatum = pmustFindDatum @(PAsData PStakeDatum) # stakeInputF.datum # txInfoF.datums + let stakeInputDatum = pfromOutputDatum @(PAsData PStakeDatum) # stakeInputF.datum # txInfoF.datums stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum @@ -358,7 +357,7 @@ governorValidator as = proposalOutputDatum' <- pletC $ - pmustFindDatum @(PAsData PProposalDatum) + pfromOutputDatum @(PAsData PProposalDatum) # (pfield @"datum" #$ phead # outputsToProposalValidatorWithStateToken) # txInfoF.datums @@ -404,7 +403,7 @@ governorValidator as = pure $ pif (psymbolValueOf # psstSymbol # txOutF.value #== 1) - (pfindDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums) + (ptryFromOutputDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums) (pcon PNothing) ) # pfromData txInfoF.outputs @@ -452,7 +451,7 @@ governorValidator as = ( psymbolValueOf # ppstSymbol # txOutF.value #== 1 #&& txOutF.address #== pdata pproposalValidatorAddress ) - (pfindDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums) + (ptryFromOutputDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums) pnothing ) # pfromData txInfoF.inputs diff --git a/agora/Agora/Plutarch/Orphans.hs b/agora/Agora/Plutarch/Orphans.hs index 1f22824..47e5696 100644 --- a/agora/Agora/Plutarch/Orphans.hs +++ b/agora/Agora/Plutarch/Orphans.hs @@ -1,54 +1,3 @@ {-# OPTIONS_GHC -Wno-orphans #-} -{- FIXME: All of the following instances and - types ought to belong in either plutarch or - plutarch-extra. --} - module Agora.Plutarch.Orphans () where - -import Plutarch.Api.V2 (PDatumHash (..), PScriptHash (..)) -import Plutarch.Builtin (PIsData (..)) -import Plutarch.Extra.TermCont (ptryFromC) -import Plutarch.TryFrom (PTryFrom (..)) -import Plutarch.Unsafe (punsafeCoerce) - -newtype Flip f a b = Flip (f b a) deriving stock (Generic) - --- | @since 0.1.0 -instance PTryFrom PData (PAsData PDatumHash) where - type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash - ptryFrom' opq = runTermCont $ do - (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq - - tcont $ \f -> - pif - -- Blake2b_256 hash: 256 bits/32 bytes. - (plengthBS # unwrapped #== 32) - (f ()) - (ptraceError "ptryFrom(PDatumHash): must be 32 bytes long") - - pure (punsafeCoerce opq, pcon $ PDatumHash unwrapped) - --- | @since 0.2.0 -instance PTryFrom PData (PAsData PUnit) - --- | @since 0.2.0 -instance (PIsData a) => PIsData (PAsData a) where - pfromDataImpl = punsafeCoerce - pdataImpl = pdataImpl . pfromData - --- | @since 1.0.0 -instance PTryFrom PData (PAsData PScriptHash) where - type PTryFromExcess PData (PAsData PScriptHash) = Flip Term PScriptHash - ptryFrom' opq = runTermCont $ do - (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq - - tcont $ \f -> - pif - -- Blake2b_224 hash: 224 bits/28 bytes. - (plengthBS # unwrapped #== 28) - (f ()) - (ptraceError "ptryFrom(PScriptHash): must be 32 bytes long") - - pure (punsafeCoerce opq, pcon $ PScriptHash unwrapped) diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 3302541..e18984d 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -83,6 +83,7 @@ import Plutarch.Lift ( PConstantDecl, PUnsafeLiftDecl (..), ) +import Plutarch.Orphans () import Plutarch.SafeMoney (PDiscrete (..)) import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash) import PlutusTx qualified diff --git a/agora/Agora/Proposal/Scripts.hs b/agora/Agora/Proposal/Scripts.hs index ab133e9..1bd3a9b 100644 --- a/agora/Agora/Proposal/Scripts.hs +++ b/agora/Agora/Proposal/Scripts.hs @@ -38,10 +38,7 @@ import Agora.Stake ( pisVoter, ) import Agora.Utils ( - pfromDatumHash, pltAsData, - pmustFindDatum, - ptryFindDatum, ) import Plutarch.Api.V2 ( PDatumHash, @@ -62,7 +59,10 @@ import Plutarch.Extra.Maybe (passertPJust, pfromJust, pisJust) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.ScriptContext ( pfindTxInByTxOutRef, + pfromDatumHash, + pfromOutputDatum, pisTokenSpent, + ptryFindDatum, ) import Plutarch.Extra.TermCont ( pguardC, @@ -213,7 +213,7 @@ proposalValidator as maximumCosigners = -- Maybe we can cache the sorted datum map? let datum = pfromData $ - pmustFindDatum @(PAsData PProposalDatum) + pfromOutputDatum @(PAsData PProposalDatum) # inputF.datum # txInfoF.datums @@ -229,7 +229,7 @@ proposalValidator as maximumCosigners = proposalOut <- pletC $ pfromData $ - pmustFindDatum @(PAsData PProposalDatum) + pfromOutputDatum @(PAsData PProposalDatum) # (pfield @"datum" # ownOutput) # txInfoF.datums diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 9b0413e..cea72c4 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -50,6 +50,7 @@ import Plutarch.Extra.List (pnotNull) import Plutarch.Extra.Sum (PSum (..)) import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) +import Plutarch.Orphans () import Plutarch.SafeMoney (PDiscrete) import PlutusLedgerApi.V1 (Credential) import PlutusTx qualified diff --git a/agora/Agora/Stake/Scripts.hs b/agora/Agora/Stake/Scripts.hs index 875e8e8..3ed1fd4 100644 --- a/agora/Agora/Stake/Scripts.hs +++ b/agora/Agora/Stake/Scripts.hs @@ -16,10 +16,6 @@ import Agora.Stake ( StakeRedeemer (WitnessStake), pstakeLocked, ) -import Agora.Utils ( - pfromDatumHash, - pmustFindDatum, - ) import Data.Function (on) import Data.Tagged (Tagged (..), untag) import Plutarch.Api.V1 ( @@ -45,7 +41,12 @@ import Plutarch.Extra.Field (pletAllC) import Plutarch.Extra.List (pmapMaybe, pmsortBy) import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) -import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, pvalueSpent) +import Plutarch.Extra.ScriptContext ( + pfindTxInByTxOutRef, + pfromDatumHash, + pfromOutputDatum, + pvalueSpent, + ) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.Extra.Value ( pgeqByClass', @@ -114,7 +115,7 @@ stakePolicy gtClassRef = (psymbolValueOf # ownSymbol # txOutF.value #== 1) ( let datum = pfromData $ - pmustFindDatum @(PAsData PStakeDatum) + pfromOutputDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums in pnot # (pstakeLocked # datum) @@ -158,7 +159,7 @@ stakePolicy gtClassRef = pletFieldsC @'["owner", "stakedAmount"] $ pto $ pfromData $ - pmustFindDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums + pfromOutputDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums let hasExpectedStake = ptraceIfFalse "Stake ouput has expected amount of stake token" $ @@ -378,7 +379,7 @@ stakeValidator as gtClassRef = stakeOut <- pletC $ pfromData $ - pmustFindDatum @(PAsData PStakeDatum) + pfromOutputDatum @(PAsData PStakeDatum) # (pfield @"datum" # ownOutput) # txInfoF.datums diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index a7c8116..6ad41c2 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -16,28 +16,8 @@ module Agora.Utils ( CompiledValidator (..), CompiledMintingPolicy (..), CompiledEffect (..), - presolveOutputDatum, - pfindDatum, - pmustFindDatum, - (#.*), - (#.**), - pfromDatumHash, - pfromInlineDatum, - ptryFindDatum, - pfstTuple, - psndTuple, ) where -import Plutarch.Api.V1.AssocMap (KeyGuarantees (Unsorted), PMap) -import Plutarch.Api.V1.AssocMap qualified as PAssocMap -import Plutarch.Api.V2 ( - PDatum, - PDatumHash, - POutputDatum (..), - PTuple, - ) -import Plutarch.Extra.Functor (pfmap) -import Plutarch.Extra.Maybe (passertPJust, pjust, pnothing) import PlutusLedgerApi.V2 ( Address (..), Credential (..), @@ -118,137 +98,3 @@ newtype CompiledMintingPolicy (redeemer :: Type) = CompiledMintingPolicy newtype CompiledEffect (datum :: Type) = CompiledEffect { getCompiledEffect :: Validator } - --- @since 1.0.0 -presolveOutputDatum :: - forall s. - Term - s - ( POutputDatum - :--> PMap 'Unsorted PDatumHash PDatum - :--> PMaybe PDatum - ) -presolveOutputDatum = phoistAcyclic $ - plam $ \od m -> pmatch od $ \case - PNoOutputDatum _ -> - ptrace "no datum" pnothing - POutputDatum ((pfield @"outputDatum" #) -> datum) -> - ptrace "datum hash" pjust # datum - POutputDatumHash ((pfield @"datumHash" #) -> hash) -> - PAssocMap.plookup - # hash - # m - --- | @since 1.0.0 -pfindDatum :: - forall datum s. - PTryFrom PData datum => - Term - s - ( POutputDatum - :--> PMap 'Unsorted PDatumHash PDatum - :--> PMaybe datum - ) -pfindDatum = phoistAcyclic $ - plam $ \od m -> - pfmap - # phoistAcyclic (plam $ flip ptryFrom fst . pto) - # (presolveOutputDatum # od # m) - --- | @since 1.0.0 -pmustFindDatum :: - forall datum s. - (PIsData datum, PTryFrom PData datum) => - Term - s - ( POutputDatum - :--> PMap 'Unsorted PDatumHash PDatum - :--> datum - ) -pmustFindDatum = - phoistAcyclic $ - plam $ - (passertPJust # "datum not found") #.* pfindDatum - --- | @since 1.0.0 -pfromDatumHash :: forall s. Term s (POutputDatum :--> PDatumHash) -pfromDatumHash = phoistAcyclic $ - plam $ - flip pmatch $ \case - POutputDatumHash ((pfield @"datumHash" #) -> hash) -> hash - _ -> ptraceError "not a datum hash" - --- | @since 1.0.0 -pfromInlineDatum :: forall s. Term s (POutputDatum :--> PDatum) -pfromInlineDatum = phoistAcyclic $ - plam $ - flip pmatch $ \case - POutputDatum ((pfield @"outputDatum" #) -> datum) -> datum - _ -> ptraceError "not an inline datum" - -{- | Find a datum with the given hash, and 'ptryFrom' it. - - @since 1.0.0 --} -ptryFindDatum :: - forall datum (s :: S). - PTryFrom PData datum => - Term - s - ( PDatumHash - :--> PMap 'Unsorted PDatumHash PDatum - :--> PMaybe datum - ) -ptryFindDatum = - phoistAcyclic $ - plam $ - (pfmap # ptryFromDatum) - #.* PAssocMap.plookup - -{- | Convert a 'PDatum' to the given datum type. - - @since 1.0.0 --} -ptryFromDatum :: - forall datum s. - (PTryFrom PData datum) => - Term s (PDatum :--> datum) -ptryFromDatum = phoistAcyclic $ plam $ flip ptryFrom fst . pto - -infixr 8 #.* -infixr 8 #.** - --- | @since 1.0.0 -(#.*) :: - forall d c b a s. - Term s (c :--> d) -> - Term s (a :--> b :--> c) -> - Term s a -> - Term s b -> - Term s d -(#.*) f g x y = f #$ g # x # y - --- | @since 1.0.0 -(#.**) :: - forall e d c b a s. - Term s (d :--> e) -> - Term s (a :--> b :--> c :--> d) -> - Term s a -> - Term s b -> - Term s c -> - Term s e -(#.**) f g x y z = f #$ g # x # y # z - -{- | Extract the first component of a 'PTuple'. - - @since 1.0.0 --} -pfstTuple :: forall a b s. (PIsData a) => Term s (PTuple a b :--> a) -pfstTuple = phoistAcyclic $ plam $ pfromData . (pfield @"_0" #) - -{- | Extract the second component of a 'PTuple'. - - @since 1.0.0 --} -psndTuple :: forall b a s. (PIsData b) => Term s (PTuple a b :--> b) -psndTuple = phoistAcyclic $ plam $ pfromData . (pfield @"_1" #)