From 7c59888b452b5d9d7c9e85cd8fff3abe32168715 Mon Sep 17 00:00:00 2001 From: Emily Martins Date: Wed, 20 Apr 2022 18:36:45 +0200 Subject: [PATCH] drop `allInputs`, fix `authorityTokensValidIn` --- agora/Agora/AuthorityToken.hs | 30 ++++++++++++++++++------------ agora/Agora/Utils.hs | 25 ------------------------- 2 files changed, 18 insertions(+), 37 deletions(-) diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index dadabe4..1956fb6 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -34,7 +34,6 @@ import Prelude -------------------------------------------------------------------------------- import Agora.Utils ( - allInputs, allOutputs, passert, passetClassValueOf, @@ -81,15 +80,16 @@ authorityTokensValidIn = phoistAcyclic $ pmatch (pfield @"credential" # address) $ \case PPubKeyCredential _ -> -- 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 PMap tokenMap <- pmatch tokenMap' - pall - # plam - ( \pair -> - pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred) - ) - # tokenMap + ptraceIfFalse "authorityTokensValidIn: GAT TokenName doesn't match ScriptHash" $ + pall + # plam + ( \pair -> + pforgetData (pfstBuiltin # pair) #== pforgetData (pdata cred) + ) + # tokenMap PNothing -> -- No GATs exist at this output! pconstant True @@ -105,14 +105,20 @@ singleAuthorityTokenBurned gatCs txInfo mint = P.do let gatAmountMinted :: Term _ PInteger gatAmountMinted = psymbolValueOf # gatCs # mint + txInfoF <- pletFields @'["inputs"] $ txInfo + foldr1 (#&&) [ ptraceIfFalse "GAT not burned." $ gatAmountMinted #== -1 , ptraceIfFalse "All inputs only have valid GATs" $ - allInputs @PUnit # pfromData txInfo #$ plam $ \txOut _value _address _datum -> - authorityTokensValidIn - # gatCs - # txOut + pall + # plam + ( \txInInfo' -> P.do + PTxInInfo txInInfo <- pmatch (pfromData txInInfo') + let txOut' = pfield @"resolved" # txInInfo + authorityTokensValidIn # gatCs # pfromData txOut' + ) + # txInfoF.inputs ] -- | Policy given 'AuthorityToken' params. diff --git a/agora/Agora/Utils.hs b/agora/Agora/Utils.hs index e05e4ee..48e5af3 100644 --- a/agora/Agora/Utils.hs +++ b/agora/Agora/Utils.hs @@ -32,7 +32,6 @@ module Agora.Utils ( anyOutput, allOutputs, anyInput, - allInputs, findTxOutByTxOutRef, scriptHashFromAddress, findOutputsToAddress, @@ -376,30 +375,6 @@ anyInput = phoistAcyclic $ ) # 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. psingletonValue :: forall s. Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PValue) psingletonValue = phoistAcyclic $