use utils from LPE

This commit is contained in:
Hongrui Fang 2022-08-17 21:58:45 +08:00
parent 548cd8c2eb
commit cb45b5255b
No known key found for this signature in database
GPG key ID: F10AB2CCE24113DD
9 changed files with 29 additions and 232 deletions

View file

@ -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

View file

@ -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.

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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" #)