Sulkta-OSS/agora
3
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

yeet containsSingleCurrencySymbol; clean things up

Browse source
This commit is contained in:
fanghr 2022-04-21 23:15:16 +08:00
parent 1b8d322cf4
commit 4a645af531
2 changed files with 19 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

26
agora/Agora/Governor.hs
View file

@ -42,7 +42,7 @@ import Agora.AuthorityToken (
import Agora.Proposal ( import Agora.Proposal (
PProposalDatum, PProposalDatum,
PProposalId, PProposalId,
PProposalStatus (PExecutable, PFinished, PDraft), PProposalStatus (PDraft, PExecutable, PFinished),
PProposalThresholds, PProposalThresholds,
PProposalVotes (PProposalVotes), PProposalVotes (PProposalVotes),
PResultTag (PResultTag), PResultTag (PResultTag),
@ -349,7 +349,7 @@ governorValidator params =
PDraft _ -> pconstant True PDraft _ -> pconstant True
_ -> pconstant False _ -> pconstant False
passert "Proposal state should be draft" $ isProposalDraft passert "Proposal state should be draft" isProposalDraft
popaque $ pconstant () popaque $ pconstant ()
PMintGATs _ -> P.do PMintGATs _ -> P.do
@ -360,7 +360,8 @@ governorValidator params =
inputsWithProposalStateToken <- inputsWithProposalStateToken <-
plet $ plet $
pfilter pfilter
# ( plam $ \(((pfield @"value" #) . (pfield @"resolved" #)) -> value) -> # plam
( \((pfield @"value" #) . (pfield @"resolved" #) -> value) ->
psymbolValueOf # pproposalSym # value #== 1 psymbolValueOf # pproposalSym # value #== 1
) )
#$ pfromData txInfo.inputs #$ pfromData txInfo.inputs
@ -368,7 +369,8 @@ governorValidator params =
outputsWithProposalStateToken <- outputsWithProposalStateToken <-
plet $ plet $
pfilter pfilter
# ( plam $ \((pfield @"value" #) -> value) -> # plam
( \((pfield @"value" #) -> value) ->
psymbolValueOf # pproposalSym # value #== 1 psymbolValueOf # pproposalSym # value #== 1
) )
#$ pfromData txInfo.outputs #$ pfromData txInfo.outputs
@ -410,13 +412,13 @@ governorValidator params =
PExecutable _ -> pconstant True PExecutable _ -> pconstant True
_ -> pconstant False _ -> pconstant False
passert "Proposal must be in executable state in order to execute effects" $ isProposalExecutable passert "Proposal must be in executable state in order to execute effects" isProposalExecutable
-- TODO: not sure if I did the right thing, can't use haskell level constructor here -- TODO: not sure if I did the right thing, can't use haskell level constructor here
let fields = let fields =
pdcons @"id" # inputProposalDatum.id pdcons @"id" # inputProposalDatum.id
#$ pdcons @"effects" # inputProposalDatum.effects #$ pdcons @"effects" # inputProposalDatum.effects
#$ pdcons @"status" # (pdata $ pcon $ PFinished pdnil) #$ pdcons @"status" # pdata (pcon $ PFinished pdnil)
#$ pdcons @"cosigners" # inputProposalDatum.cosigners #$ pdcons @"cosigners" # inputProposalDatum.cosigners
#$ pdcons @"thresholds" # inputProposalDatum.thresholds #$ pdcons @"thresholds" # inputProposalDatum.thresholds
#$ pdcons @"votes" # inputProposalDatum.votes # pdnil #$ pdcons @"votes" # inputProposalDatum.votes # pdnil
@ -424,7 +426,7 @@ governorValidator params =
expectedOutputDatum = pforgetData $ pdata fields expectedOutputDatum = pforgetData $ pdata fields
passert "Unexpected output proposal datum" $ passert "Unexpected output proposal datum" $
(pforgetData $ pdata outputProposalDatum') #== expectedOutputDatum pforgetData (pdata outputProposalDatum') #== expectedOutputDatum
-- TODO: anything else to check here? -- TODO: anything else to check here?
@ -452,7 +454,8 @@ governorValidator params =
outputsWithGAT <- outputsWithGAT <-
plet $ plet $
pfilter pfilter
# ( plam $ \((pfield @"value" #) -> value) -> # plam
( \((pfield @"value" #) -> value) ->
0 #< psymbolValueOf # pgatSym # value 0 #< psymbolValueOf # pgatSym # value
) )
#$ pfromData txInfo.outputs #$ pfromData txInfo.outputs
@ -462,7 +465,8 @@ governorValidator params =
popaque $ popaque $
pfoldr pfoldr
# ( plam $ \(pfromData -> output') _ -> P.do # plam
( \(pfromData -> output') _ -> P.do
output <- pletFields @'["address", "datumHash"] $ output' output <- pletFields @'["address", "datumHash"] $ output'
let scriptHash = let scriptHash =
@ -478,9 +482,9 @@ governorValidator params =
passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output' passert "GAT must be tagged by the effect hash" $ authorityTokensValidIn # pgatSym # output'
passert "Unexpected datum" $ datumHash #== expectedDatumHash passert "Unexpected datum" $ datumHash #== expectedDatumHash
(pconstant ()) pconstant ()
) )
# (pconstant ()) # pconstant ()
# outputsWithGAT # outputsWithGAT
PMutateGovernor _ -> P.do PMutateGovernor _ -> P.do
popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint popaque $ singleAuthorityTokenBurned pgatSym ctx.txInfo txInfo.mint

6
agora/Agora/Utils.hs
View file

@ -47,7 +47,6 @@ module Agora.Utils (
hasOnlyOneTokenOfAssetClass', hasOnlyOneTokenOfAssetClass',
hasOnlyOneTokenOfCurrencySymbol, hasOnlyOneTokenOfCurrencySymbol,
mustFindDatum', mustFindDatum',
containsSingleCurrencySymbol,
mustBePJust, mustBePJust,
mustBePDJust, mustBePDJust,
) where ) where
@ -554,11 +553,6 @@ mustFindDatum' = phoistAcyclic $
PJust dt <- pmatch $ pfindDatum # dh # info PJust dt <- pmatch $ pfindDatum # dh # info
pfromData $ punsafeCoerce dt pfromData $ punsafeCoerce dt
containsSingleCurrencySymbol :: Term s (PValue :--> PBool)
containsSingleCurrencySymbol = phoistAcyclic $
plam $ \v -> P.do
(plength #$ pto $ pto $ pto v) #== 1
mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a) mustBePJust :: forall a s. Term s (PString :--> PMaybe a :--> a)
mustBePJust = phoistAcyclic $ mustBePJust = phoistAcyclic $
plam $ \emsg mv' -> pmatch mv' $ \case plam $ \emsg mv' -> pmatch mv' $ \case