fix compilation errors

This commit is contained in:
fanghr 2022-05-07 14:08:11 +08:00
parent dd79a7b73a
commit 0440e00410

View file

@ -20,31 +20,34 @@ module Agora.Effect.GovernorMutation (
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Control.Applicative (Const)
import GHC.Generics qualified as GHC import GHC.Generics qualified as GHC
import Generics.SOP (Generic, I (I)) import Generics.SOP (Generic, I (I))
import Prelude
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutarch (popaque)
import Plutarch.Api.V1 ( import Plutarch.Api.V1 (
PMaybeData (PDJust), PMaybeData (PDJust),
PTxOutRef, PTxOutRef,
PValidator, PValidator,
PValue, PValue,
) )
import Plutarch.Api.V1.Extra (pvalueOf)
import Plutarch.Builtin (pforgetData) import Plutarch.Builtin (pforgetData)
import Plutarch.DataRepr ( import Plutarch.DataRepr (
DerivePConstantViaData (..), DerivePConstantViaData (..),
PDataFields, PDataFields,
PIsDataReprInstances (PIsDataReprInstances), PIsDataReprInstances (PIsDataReprInstances),
) )
import Plutarch.Lift (PLifted, PUnsafeLiftDecl) import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
import Plutarch.Monadic qualified as P import Plutarch.Monadic qualified as P
import Plutarch.TryFrom (PTryFrom (..))
import Plutarch.Unsafe (punsafeCoerce)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
import Plutus.V1.Ledger.Api (TxOutRef) import Plutus.V1.Ledger.Api (TxOutRef)
import Plutus.V1.Ledger.Value (AssetClass (..))
import PlutusTx qualified import PlutusTx qualified
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -54,13 +57,14 @@ import Agora.Governor (
Governor, Governor,
GovernorDatum, GovernorDatum,
PGovernorDatum, PGovernorDatum,
gatSymbol, )
gstAssetClass, import Agora.Governor.Scripts (
authorityTokenSymbolFromGovernor,
governorSTAssetClassFromGovernor,
) )
import Agora.Utils ( import Agora.Utils (
findOutputsToAddress, findOutputsToAddress,
passert, passert,
passetClassValueOf',
pfindDatum, pfindDatum,
) )
@ -99,7 +103,13 @@ newtype PMutateGovernorDatum (s :: S)
via (PIsDataReprInstances PMutateGovernorDatum) via (PIsDataReprInstances PMutateGovernorDatum)
instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum instance PUnsafeLiftDecl PMutateGovernorDatum where type PLifted PMutateGovernorDatum = MutateGovernorDatum
deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) instance (PConstant MutateGovernorDatum) deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) instance (PConstantDecl MutateGovernorDatum)
-- TODO: Derive this.
instance PTryFrom PData PMutateGovernorDatum where
type PTryFromExcess PData PMutateGovernorDatum = Const ()
ptryFrom' d k =
k (punsafeCoerce d, ())
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -119,12 +129,12 @@ deriving via (DerivePConstantViaData MutateGovernorDatum PMutateGovernorDatum) i
- A new UTXO, containing the GST and the new governor state datum, is paid to the governor. - A new UTXO, containing the GST and the new governor state datum, is paid to the governor.
-} -}
mutateGovernorValidator :: Governor -> ClosedTerm PValidator mutateGovernorValidator :: Governor -> ClosedTerm PValidator
mutateGovernorValidator gov = makeEffect (gatSymbol gov) $ mutateGovernorValidator gov = makeEffect (authorityTokenSymbolFromGovernor gov) $
\_gatCs (datum :: Term _ PMutateGovernorDatum) _txOutRef txInfo' -> P.do \_gatCs (datum :: Term _ PMutateGovernorDatum) _txOutRef txInfo' -> P.do
let newDatum = pforgetData $ pfield @"newDatum" # datum let newDatum = pforgetData $ pfield @"newDatum" # datum
pinnedGovernor = pfield @"governorRef" # datum pinnedGovernor = pfield @"governorRef" # datum
txInfo <- pletFields @'["mint", "inputs", "outputs"] txInfo' txInfo <- pletFields @'["mint", "inputs", "outputs", "datums"] txInfo'
let mint :: Term _ (PBuiltinList _) let mint :: Term _ (PBuiltinList _)
mint = pto $ pto $ pto $ pfromData txInfo.mint mint = pto $ pto $ pto $ pfromData txInfo.mint
@ -135,7 +145,8 @@ mutateGovernorValidator gov = makeEffect (gatSymbol gov) $
filteredInputs <- filteredInputs <-
plet $ plet $
pfilter pfilter
# ( plam $ \inInfo -> # plam
( \inInfo ->
let value = pfield @"value" #$ pfield @"resolved" # inInfo let value = pfield @"value" #$ pfield @"resolved" # inInfo
in gstValueOf # value #== 1 in gstValueOf # value #== 1
) )
@ -154,7 +165,7 @@ mutateGovernorValidator gov = makeEffect (gatSymbol gov) $
#$ pfield @"resolved" #$ pfield @"resolved"
#$ pfromData input #$ pfromData input
filteredOutputs <- plet $ findOutputsToAddress # pfromData txInfo' # govAddress filteredOutputs <- plet $ findOutputsToAddress # pfromData txInfo.outputs # govAddress
passert "Exactly one output to the governor" $ passert "Exactly one output to the governor" $
plength # filteredOutputs #== 1 plength # filteredOutputs #== 1
@ -167,8 +178,8 @@ mutateGovernorValidator gov = makeEffect (gatSymbol gov) $
outputDatumHash' <- pmatch $ pfromData $ pfield @"datumHash" # outputToGovernor outputDatumHash' <- pmatch $ pfromData $ pfield @"datumHash" # outputToGovernor
case outputDatumHash' of case outputDatumHash' of
PDJust ((pfromData . (pfield @"_0" #)) -> outputDatumHash) -> P.do PDJust (pfromData . (pfield @"_0" #) -> outputDatumHash) -> P.do
datum' <- pmatch $ pfindDatum # outputDatumHash # pfromData txInfo' datum' <- pmatch $ pfindDatum # outputDatumHash # pfromData txInfo.datums
case datum' of case datum' of
PJust datum -> P.do PJust datum -> P.do
passert "Unexpected output datum" $ passert "Unexpected output datum" $
@ -179,4 +190,6 @@ mutateGovernorValidator gov = makeEffect (gatSymbol gov) $
_ -> ptraceError "Ouput to governor should have datum" _ -> ptraceError "Ouput to governor should have datum"
where where
gstValueOf :: Term s (PValue :--> PInteger) gstValueOf :: Term s (PValue :--> PInteger)
gstValueOf = passetClassValueOf' $ gstAssetClass gov gstValueOf = phoistAcyclic $ plam $ \v -> pvalueOf # v # pconstant cs # pconstant tn
where
AssetClass (cs, tn) = governorSTAssetClassFromGovernor gov