switch to TermCont; fix a bunch of compilation errors; format

This commit is contained in:
fanghr 2022-05-16 21:24:43 +08:00
parent 2e21e4c94a
commit 1e55827d8b
No known key found for this signature in database
GPG key ID: 35CD9A71CD5D5870
4 changed files with 32 additions and 24 deletions

View file

@ -31,7 +31,15 @@ import Plutus.V1.Ledger.Api (
import Plutus.V1.Ledger.Api qualified as Interval
import Plutus.V1.Ledger.Value (AssetClass, assetClass)
import Plutus.V1.Ledger.Value qualified as Value
import Sample.Shared
import Sample.Shared (
authorityTokenSymbol,
defaultProposalThresholds,
govAssetClass,
govValidatorAddress,
governor,
minAda,
signer,
)
import Test.Util (datumPair, toDatumHash)
effectValidator :: Validator
@ -112,7 +120,7 @@ validContext =
governorOutput =
TxOut
{ txOutAddress = govValidatorAddress
, txOutValue = withMinAda gst
, txOutValue = mconcat [gst, minAda]
, txOutDatumHash = Just $ toDatumHash governorOutputDatum
}

View file

@ -4,10 +4,10 @@ import Agora.Effect.GovernorMutation (MutateGovernorDatum (..), mutateGovernorVa
import Agora.Governor (GovernorDatum (..))
import Agora.Proposal (ProposalId (..))
import Plutus.V1.Ledger.Api (TxOutRef (..))
import Spec.Sample.Effect.GovernorMutation
import Spec.Sample.Shared
import Spec.Util (effectSucceedsWith)
import Sample.Effect.GovernorMutation (validContext)
import Sample.Shared (defaultProposalThresholds, governor)
import Test.Tasty (TestTree, testGroup)
import Test.Util (effectSucceedsWith)
tests :: [TestTree]
tests =

View file

@ -38,7 +38,6 @@ import Plutarch.DataRepr (
PIsDataReprInstances (PIsDataReprInstances),
)
import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import Plutarch.Monadic qualified as P
import Plutarch.TryFrom (PTryFrom (..))
import Plutarch.Unsafe (punsafeCoerce)
@ -65,8 +64,8 @@ import Agora.Utils (
isScriptAddress,
mustBePDJust,
mustBePJust,
passert,
ptryFindDatum,
tcassert,
)
--------------------------------------------------------------------------------
@ -139,17 +138,17 @@ instance PTryFrom PData (PAsData PMutateGovernorDatum) where
-}
mutateGovernorValidator :: Governor -> ClosedTerm PValidator
mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
\_gatCs (datum' :: Term _ PMutateGovernorDatum) _ txInfo' -> P.do
datum <- pletFields @'["newDatum", "governorRef"] datum'
txInfo <- pletFields @'["mint", "inputs", "outputs", "datums"] txInfo'
\_gatCs (datum' :: Term _ PMutateGovernorDatum) _ txInfo' -> unTermCont $ do
datum <- tcont $ pletFields @'["newDatum", "governorRef"] datum'
txInfo <- tcont $ pletFields @'["mint", "inputs", "outputs", "datums"] txInfo'
let mint :: Term _ (PBuiltinList _)
mint = pto $ pto $ pto $ pfromData txInfo.mint
passert "Nothing should be minted/burnt other than GAT" $
tcassert "Nothing should be minted/burnt other than GAT" $
plength # mint #== 1
passert "Only self and governor script inputs are allowed" $
tcassert "Only self and governor script inputs are allowed" $
pfoldr
# phoistAcyclic
( plam $ \inInfo count ->
@ -172,23 +171,23 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
)
# pfromData txInfo.inputs
govInInfo <- pletFields @'["outRef", "resolved"] $ inputWithGST
govInInfo <- tcont $ pletFields @'["outRef", "resolved"] $ inputWithGST
passert "Can only modify the pinned governor" $
tcassert "Can only modify the pinned governor" $
govInInfo.outRef #== datum.governorRef
passert "Only governor ouput is allowed" $
tcassert "Only governor ouput is allowed" $
plength # pfromData txInfo.outputs #== 1
let govAddress = pfield @"address" #$ govInInfo.resolved
govOutput' = pfromData $ phead # pfromData txInfo.outputs
govOutput <- pletFields @'["address", "value", "datumHash"] govOutput'
govOutput <- tcont $ pletFields @'["address", "value", "datumHash"] govOutput'
passert "No output to the governor" $
tcassert "No output to the governor" $
govOutput.address #== govAddress
passert "Governor output doesn't carry the GST" $
tcassert "Governor output doesn't carry the GST" $
gstValueOf # govOutput.value #== 1
let governorOutputDatumHash =
@ -198,10 +197,10 @@ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov)
mustBePJust # "Governor output datum not found"
#$ ptryFindDatum # governorOutputDatumHash # txInfo.datums
passert "Unexpected governor datum" $ datum.newDatum #== governorOutputDatum
passert "New governor datum should be valid" $ governorDatumValid # governorOutputDatum
tcassert "Unexpected governor datum" $ datum.newDatum #== governorOutputDatum
tcassert "New governor datum should be valid" $ governorDatumValid # governorOutputDatum
popaque $ pconstant ()
return $ popaque $ pconstant ()
where
gstValueOf :: Term s (PValue :--> PInteger)
gstValueOf = phoistAcyclic $ plam $ \v -> pvalueOf # v # pconstant cs # pconstant tn

View file

@ -59,7 +59,7 @@ module Agora.Utils (
validatorHashToAddress,
pmergeBy,
phalve,
isScriptAddress
isScriptAddress,
) where
--------------------------------------------------------------------------------
@ -621,8 +621,9 @@ scriptHashFromAddress = phoistAcyclic $
_ -> pcon PNothing
isScriptAddress :: Term s (PAddress :--> PBool)
isScriptAddress = phoistAcyclic $ plam $ \addr ->
pmatch (pfromData $ pfield @"credential" # addr) $ \case
isScriptAddress = phoistAcyclic $
plam $ \addr ->
pmatch (pfromData $ pfield @"credential" # addr) $ \case
PScriptCredential _ -> pconstant True
_ -> pconstant False