drop allInputs, fix authorityTokensValidIn
This commit is contained in:
parent
bb54cd6a18
commit
27f5b5de16
2 changed files with 18 additions and 37 deletions
|
|
@ -34,7 +34,6 @@ import Prelude
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
|
|
||||||
import Agora.Utils (
|
import Agora.Utils (
|
||||||
allInputs,
|
|
||||||
allOutputs,
|
allOutputs,
|
||||||
passert,
|
passert,
|
||||||
passetClassValueOf,
|
passetClassValueOf,
|
||||||
|
|
@ -81,15 +80,16 @@ authorityTokensValidIn = phoistAcyclic $
|
||||||
pmatch (pfield @"credential" # address) $ \case
|
pmatch (pfield @"credential" # address) $ \case
|
||||||
PPubKeyCredential _ ->
|
PPubKeyCredential _ ->
|
||||||
-- GATs should only be sent to Effect validators
|
-- GATs should only be sent to Effect validators
|
||||||
pconstant False
|
ptraceIfFalse "authorityTokensValidIn: GAT incorrectly lives at PubKey" $ pconstant False
|
||||||
PScriptCredential ((pfromData . (pfield @"_0" #)) -> cred) -> P.do
|
PScriptCredential ((pfromData . (pfield @"_0" #)) -> cred) -> P.do
|
||||||
PMap tokenMap <- pmatch tokenMap'
|
PMap tokenMap <- pmatch tokenMap'
|
||||||
pall
|
ptraceIfFalse "authorityTokensValidIn: GAT TokenName doesn't match ScriptHash" $
|
||||||
# plam
|
pall
|
||||||
( \pair ->
|
# plam
|
||||||
pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred)
|
( \pair ->
|
||||||
)
|
pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred)
|
||||||
# tokenMap
|
)
|
||||||
|
# tokenMap
|
||||||
PNothing ->
|
PNothing ->
|
||||||
-- No GATs exist at this output!
|
-- No GATs exist at this output!
|
||||||
pconstant True
|
pconstant True
|
||||||
|
|
@ -105,14 +105,20 @@ singleAuthorityTokenBurned gatCs txInfo mint = P.do
|
||||||
let gatAmountMinted :: Term _ PInteger
|
let gatAmountMinted :: Term _ PInteger
|
||||||
gatAmountMinted = psymbolValueOf # gatCs # mint
|
gatAmountMinted = psymbolValueOf # gatCs # mint
|
||||||
|
|
||||||
|
txInfoF <- pletFields @'["inputs"] $ txInfo
|
||||||
|
|
||||||
foldr1
|
foldr1
|
||||||
(#&&)
|
(#&&)
|
||||||
[ ptraceIfFalse "GAT not burned." $ gatAmountMinted #== -1
|
[ ptraceIfFalse "GAT not burned." $ gatAmountMinted #== -1
|
||||||
, ptraceIfFalse "All inputs only have valid GATs" $
|
, ptraceIfFalse "All inputs only have valid GATs" $
|
||||||
allInputs @PUnit # pfromData txInfo #$ plam $ \txOut _value _address _datum ->
|
pall
|
||||||
authorityTokensValidIn
|
# plam
|
||||||
# gatCs
|
( \txInInfo' -> P.do
|
||||||
# txOut
|
PTxInInfo txInInfo <- pmatch (pfromData txInInfo')
|
||||||
|
let txOut' = pfield @"resolved" # txInInfo
|
||||||
|
authorityTokensValidIn # gatCs # pfromData txOut'
|
||||||
|
)
|
||||||
|
# txInfoF.inputs
|
||||||
]
|
]
|
||||||
|
|
||||||
-- | Policy given 'AuthorityToken' params.
|
-- | Policy given 'AuthorityToken' params.
|
||||||
|
|
|
||||||
|
|
@ -32,7 +32,6 @@ module Agora.Utils (
|
||||||
anyOutput,
|
anyOutput,
|
||||||
allOutputs,
|
allOutputs,
|
||||||
anyInput,
|
anyInput,
|
||||||
allInputs,
|
|
||||||
findTxOutByTxOutRef,
|
findTxOutByTxOutRef,
|
||||||
scriptHashFromAddress,
|
scriptHashFromAddress,
|
||||||
findOutputsToAddress,
|
findOutputsToAddress,
|
||||||
|
|
@ -376,30 +375,6 @@ anyInput = phoistAcyclic $
|
||||||
)
|
)
|
||||||
# pfromData txInfo.inputs
|
# pfromData txInfo.inputs
|
||||||
|
|
||||||
-- | Check if all (resolved) inputs match the predicate.
|
|
||||||
allInputs ::
|
|
||||||
forall (datum :: PType) s.
|
|
||||||
( PIsData datum
|
|
||||||
) =>
|
|
||||||
Term s (PTxInfo :--> (PTxOut :--> PValue :--> PAddress :--> datum :--> PBool) :--> PBool)
|
|
||||||
allInputs = phoistAcyclic $
|
|
||||||
plam $ \txInfo' predicate -> P.do
|
|
||||||
txInfo <- pletFields @'["inputs"] txInfo'
|
|
||||||
pall
|
|
||||||
# plam
|
|
||||||
( \txInInfo'' -> P.do
|
|
||||||
PTxInInfo txInInfo' <- pmatch (pfromData txInInfo'')
|
|
||||||
let txOut'' = pfield @"resolved" # txInInfo'
|
|
||||||
PTxOut txOut' <- pmatch (pfromData txOut'')
|
|
||||||
txOut <- pletFields @'["value", "datumHash", "address"] txOut'
|
|
||||||
PDJust dh <- pmatch txOut.datumHash
|
|
||||||
pmatch (pfindDatum' @datum # (pfield @"_0" # dh) # txInfo') $ \case
|
|
||||||
PJust datum -> P.do
|
|
||||||
predicate # pfromData txOut'' # txOut.value # txOut.address # pfromData datum
|
|
||||||
PNothing -> pcon PFalse
|
|
||||||
)
|
|
||||||
# pfromData txInfo.inputs
|
|
||||||
|
|
||||||
-- | Create a value with a single asset class.
|
-- | Create a value with a single asset class.
|
||||||
psingletonValue :: forall s. Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue)
|
psingletonValue :: forall s. Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue)
|
||||||
psingletonValue = phoistAcyclic $
|
psingletonValue = phoistAcyclic $
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue