use utils from LPE

This commit is contained in:
Hongrui Fang 2022-08-17 21:58:45 +08:00
parent 48fa641511
commit 03a1e550d0
9 changed files with 29 additions and 232 deletions

View file

@ -26,7 +26,6 @@ import Agora.Governor (
) )
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass) import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass)
import Agora.Utils (pmustFindDatum)
import Plutarch.Api.V1 (PValue) import Plutarch.Api.V1 (PValue)
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PTxOutRef, PTxOutRef,
@ -39,7 +38,7 @@ import Plutarch.DataRepr (
import Plutarch.Extra.Maybe ( import Plutarch.Extra.Maybe (
passertPJust, passertPJust,
) )
import Plutarch.Extra.ScriptContext (pisScriptAddress) import Plutarch.Extra.ScriptContext (pfromOutputDatum, pisScriptAddress)
import Plutarch.Extra.TermCont (pguardC, pletFieldsC) import Plutarch.Extra.TermCont (pguardC, pletFieldsC)
import Plutarch.Extra.Value (pvalueOf) import Plutarch.Extra.Value (pvalueOf)
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
@ -201,7 +200,7 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $
let governorOutputDatum = let governorOutputDatum =
ptrace "Governor output datum not found" $ 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. -- Ensure the output governor datum is what we want.
pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum

View file

@ -10,6 +10,7 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where
import Agora.Effect (makeEffect) import Agora.Effect (makeEffect)
import Agora.Plutarch.Orphans () import Agora.Plutarch.Orphans ()
import Plutarch.Api.V2 (PValidator) import Plutarch.Api.V2 (PValidator)
import Plutarch.Orphans ()
import PlutusLedgerApi.V1.Value (CurrencySymbol) import PlutusLedgerApi.V1.Value (CurrencySymbol)
{- | Dummy datum for NoOp effect. {- | Dummy datum for NoOp effect.

View file

@ -51,11 +51,6 @@ import Agora.Stake (
pnumCreatedProposals, pnumCreatedProposals,
) )
import Agora.Utils ( import Agora.Utils (
pfindDatum,
pfromDatumHash,
pfstTuple,
pmustFindDatum,
psndTuple,
validatorHashToAddress, validatorHashToAddress,
) )
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
@ -81,11 +76,15 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindOutputsToAddress, pfindOutputsToAddress,
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pfromDatumHash,
pfromOutputDatum,
pisUTXOSpent, pisUTXOSpent,
pscriptHashFromAddress, pscriptHashFromAddress,
ptryFromOutputDatum,
pvalueSpent, pvalueSpent,
) )
import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC) import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Extra.Tuple (pfstTuple, psndTuple)
import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf) import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf)
import PlutusLedgerApi.V1 (TxOutRef) import PlutusLedgerApi.V1 (TxOutRef)
@ -148,7 +147,7 @@ governorPolicy initialSpend =
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
let outputDatum = pfield @"datum" # govOutput let outputDatum = pfield @"datum" # govOutput
datum = pmustFindDatum @PGovernorDatum # outputDatum # txInfoF.datums datum = pfromOutputDatum @PGovernorDatum # outputDatum # txInfoF.datums
pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum
@ -279,7 +278,7 @@ governorValidator as =
-- Check that own output have datum of type 'GovernorDatum'. -- Check that own output have datum of type 'GovernorDatum'.
newGovernorDatum <- newGovernorDatum <-
pletC $ pmustFindDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums pletC $ pfromOutputDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums
pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum
@ -328,7 +327,7 @@ governorValidator as =
stakeInputF <- pletFieldsC @'["datum", "value"] $ pfield @"resolved" # stakeInput 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 stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum
@ -358,7 +357,7 @@ governorValidator as =
proposalOutputDatum' <- proposalOutputDatum' <-
pletC $ pletC $
pmustFindDatum @(PAsData PProposalDatum) pfromOutputDatum @(PAsData PProposalDatum)
# (pfield @"datum" #$ phead # outputsToProposalValidatorWithStateToken) # (pfield @"datum" #$ phead # outputsToProposalValidatorWithStateToken)
# txInfoF.datums # txInfoF.datums
@ -404,7 +403,7 @@ governorValidator as =
pure $ pure $
pif pif
(psymbolValueOf # psstSymbol # txOutF.value #== 1) (psymbolValueOf # psstSymbol # txOutF.value #== 1)
(pfindDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums) (ptryFromOutputDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums)
(pcon PNothing) (pcon PNothing)
) )
# pfromData txInfoF.outputs # pfromData txInfoF.outputs
@ -452,7 +451,7 @@ governorValidator as =
( psymbolValueOf # ppstSymbol # txOutF.value #== 1 ( psymbolValueOf # ppstSymbol # txOutF.value #== 1
#&& txOutF.address #== pdata pproposalValidatorAddress #&& txOutF.address #== pdata pproposalValidatorAddress
) )
(pfindDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums) (ptryFromOutputDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums)
pnothing pnothing
) )
# pfromData txInfoF.inputs # pfromData txInfoF.inputs

View file

@ -1,54 +1,3 @@
{-# OPTIONS_GHC -Wno-orphans #-} {-# 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 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)

View file

@ -83,6 +83,7 @@ import Plutarch.Lift (
PConstantDecl, PConstantDecl,
PUnsafeLiftDecl (..), PUnsafeLiftDecl (..),
) )
import Plutarch.Orphans ()
import Plutarch.SafeMoney (PDiscrete (..)) import Plutarch.SafeMoney (PDiscrete (..))
import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash) import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash)
import PlutusTx qualified import PlutusTx qualified

View file

@ -38,10 +38,7 @@ import Agora.Stake (
pisVoter, pisVoter,
) )
import Agora.Utils ( import Agora.Utils (
pfromDatumHash,
pltAsData, pltAsData,
pmustFindDatum,
ptryFindDatum,
) )
import Plutarch.Api.V2 ( import Plutarch.Api.V2 (
PDatumHash, PDatumHash,
@ -62,7 +59,10 @@ import Plutarch.Extra.Maybe (passertPJust, pfromJust, pisJust)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
import Plutarch.Extra.ScriptContext ( import Plutarch.Extra.ScriptContext (
pfindTxInByTxOutRef, pfindTxInByTxOutRef,
pfromDatumHash,
pfromOutputDatum,
pisTokenSpent, pisTokenSpent,
ptryFindDatum,
) )
import Plutarch.Extra.TermCont ( import Plutarch.Extra.TermCont (
pguardC, pguardC,
@ -213,7 +213,7 @@ proposalValidator as maximumCosigners =
-- Maybe we can cache the sorted datum map? -- Maybe we can cache the sorted datum map?
let datum = let datum =
pfromData $ pfromData $
pmustFindDatum @(PAsData PProposalDatum) pfromOutputDatum @(PAsData PProposalDatum)
# inputF.datum # inputF.datum
# txInfoF.datums # txInfoF.datums
@ -229,7 +229,7 @@ proposalValidator as maximumCosigners =
proposalOut <- proposalOut <-
pletC $ pletC $
pfromData $ pfromData $
pmustFindDatum @(PAsData PProposalDatum) pfromOutputDatum @(PAsData PProposalDatum)
# (pfield @"datum" # ownOutput) # (pfield @"datum" # ownOutput)
# txInfoF.datums # txInfoF.datums

View file

@ -50,6 +50,7 @@ import Plutarch.Extra.List (pnotNull)
import Plutarch.Extra.Sum (PSum (..)) import Plutarch.Extra.Sum (PSum (..))
import Plutarch.Extra.Traversable (pfoldMap) import Plutarch.Extra.Traversable (pfoldMap)
import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..)) import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
import Plutarch.Orphans ()
import Plutarch.SafeMoney (PDiscrete) import Plutarch.SafeMoney (PDiscrete)
import PlutusLedgerApi.V1 (Credential) import PlutusLedgerApi.V1 (Credential)
import PlutusTx qualified import PlutusTx qualified

View file

@ -16,10 +16,6 @@ import Agora.Stake (
StakeRedeemer (WitnessStake), StakeRedeemer (WitnessStake),
pstakeLocked, pstakeLocked,
) )
import Agora.Utils (
pfromDatumHash,
pmustFindDatum,
)
import Data.Function (on) import Data.Function (on)
import Data.Tagged (Tagged (..), untag) import Data.Tagged (Tagged (..), untag)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
@ -45,7 +41,12 @@ import Plutarch.Extra.Field (pletAllC)
import Plutarch.Extra.List (pmapMaybe, pmsortBy) import Plutarch.Extra.List (pmapMaybe, pmsortBy)
import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData) import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData)
import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=)) 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.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
import Plutarch.Extra.Value ( import Plutarch.Extra.Value (
pgeqByClass', pgeqByClass',
@ -114,7 +115,7 @@ stakePolicy gtClassRef =
(psymbolValueOf # ownSymbol # txOutF.value #== 1) (psymbolValueOf # ownSymbol # txOutF.value #== 1)
( let datum = ( let datum =
pfromData $ pfromData $
pmustFindDatum @(PAsData PStakeDatum) pfromOutputDatum @(PAsData PStakeDatum)
# txOutF.datum # txOutF.datum
# txInfoF.datums # txInfoF.datums
in pnot # (pstakeLocked # datum) in pnot # (pstakeLocked # datum)
@ -158,7 +159,7 @@ stakePolicy gtClassRef =
pletFieldsC @'["owner", "stakedAmount"] $ pletFieldsC @'["owner", "stakedAmount"] $
pto $ pto $
pfromData $ pfromData $
pmustFindDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums pfromOutputDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums
let hasExpectedStake = let hasExpectedStake =
ptraceIfFalse "Stake ouput has expected amount of stake token" $ ptraceIfFalse "Stake ouput has expected amount of stake token" $
@ -378,7 +379,7 @@ stakeValidator as gtClassRef =
stakeOut <- stakeOut <-
pletC $ pletC $
pfromData $ pfromData $
pmustFindDatum @(PAsData PStakeDatum) pfromOutputDatum @(PAsData PStakeDatum)
# (pfield @"datum" # ownOutput) # (pfield @"datum" # ownOutput)
# txInfoF.datums # txInfoF.datums

View file

@ -16,28 +16,8 @@ module Agora.Utils (
CompiledValidator (..), CompiledValidator (..),
CompiledMintingPolicy (..), CompiledMintingPolicy (..),
CompiledEffect (..), CompiledEffect (..),
presolveOutputDatum,
pfindDatum,
pmustFindDatum,
(#.*),
(#.**),
pfromDatumHash,
pfromInlineDatum,
ptryFindDatum,
pfstTuple,
psndTuple,
) where ) 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 ( import PlutusLedgerApi.V2 (
Address (..), Address (..),
Credential (..), Credential (..),
@ -118,137 +98,3 @@ newtype CompiledMintingPolicy (redeemer :: Type) = CompiledMintingPolicy
newtype CompiledEffect (datum :: Type) = CompiledEffect newtype CompiledEffect (datum :: Type) = CompiledEffect
{ getCompiledEffect :: Validator { 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" #)