remove all instances of P.do in favour of TermCont.

This commit is contained in:
Emily Martins 2022-05-12 13:45:44 +02:00
parent 42a3db991a
commit a404a81cad
14 changed files with 671 additions and 639 deletions

View file

@ -8,10 +8,9 @@ Helpers for constructing effects.
module Agora.Effect (makeEffect) where
import Agora.AuthorityToken (singleAuthorityTokenBurned)
import Agora.Utils (passert)
import Agora.Utils (tcassert, tclet, tcmatch, tctryFrom)
import Plutarch.Api.V1 (PCurrencySymbol, PScriptPurpose (PSpending), PTxInfo, PTxOutRef, PValidator, PValue)
import Plutarch.Monadic qualified as P
import Plutarch.TryFrom (PTryFrom, ptryFrom)
import Plutarch.TryFrom (PTryFrom)
import Plutus.V1.Ledger.Value (CurrencySymbol)
--------------------------------------------------------------------------------
@ -29,28 +28,28 @@ makeEffect ::
(forall (s :: S). Term s PCurrencySymbol -> Term s datum -> Term s PTxOutRef -> Term s (PAsData PTxInfo) -> Term s POpaque) ->
ClosedTerm PValidator
makeEffect gatCs' f =
plam $ \datum _redeemer ctx' -> P.do
ctx <- pletFields @'["txInfo", "purpose"] ctx'
txInfo' <- plet ctx.txInfo
plam $ \datum _redeemer ctx' -> unTermCont $ do
ctx <- tcont $ pletFields @'["txInfo", "purpose"] ctx'
txInfo' <- tclet ctx.txInfo
-- convert input datum, PData, into desierable type
-- the way this conversion is performed should be defined
-- by PTryFrom for each datum in effect script.
(datum', _) <- ptryFrom @datum datum
(datum', _) <- tctryFrom @datum datum
-- ensure purpose is Spending.
PSpending txOutRef <- pmatch $ pfromData ctx.purpose
txOutRef' <- plet (pfield @"_0" # txOutRef)
PSpending txOutRef <- tcmatch $ pfromData ctx.purpose
txOutRef' <- tclet (pfield @"_0" # txOutRef)
-- fetch minted values to ensure single GAT is burned
txInfo <- pletFields @'["mint"] txInfo'
txInfo <- tcont $ pletFields @'["mint"] txInfo'
let mint :: Term _ PValue
mint = txInfo.mint
-- fetch script context
gatCs <- plet $ pconstant gatCs'
gatCs <- tclet $ pconstant gatCs'
passert "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint
tcassert "A single authority token has been burned" $ singleAuthorityTokenBurned gatCs txInfo' mint
-- run effect function
f gatCs datum' txOutRef' txInfo'
pure $ f gatCs datum' txOutRef' txInfo'