drop allInputs, fix authorityTokensValidIn

This commit is contained in:
Emily Martins 2022-04-20 18:36:45 +02:00
parent bb54cd6a18
commit 27f5b5de16
2 changed files with 18 additions and 37 deletions

View file

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

View file

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