More utility functions

functions that I missed from Conner's governor branch...
This commit is contained in:
Seungheon Oh 2022-04-14 17:19:18 -05:00
parent 458ce8b453
commit 0090299146

View file

@ -26,15 +26,18 @@ module Agora.Utils (
psingletonValue, psingletonValue,
pfindMap, pfindMap,
pnotNull, pnotNull,
pisJust,
-- * Functions which should (probably) not be upstreamed -- * Functions which should (probably) not be upstreamed
anyOutput, anyOutput,
allOutputs, allOutputs,
anyInput, anyInput,
allInputs, allInputs,
pisScriptAddress,
pfindEffectInput, pfindEffectInput,
pfindEffectAddress, pfindEffectAddress,
pscriptHashFromAddress,
pfindOutputsToAddress,
pfindTxOutDatum,
) where ) where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -49,7 +52,8 @@ import Plutarch.Api.V1 (
PCurrencySymbol, PCurrencySymbol,
PDatum, PDatum,
PDatumHash, PDatumHash,
PMaybeData (PDJust, PDNothing), PMap,
PMaybeData (PDJust),
PPubKeyHash, PPubKeyHash,
PTokenName, PTokenName,
PTuple, PTuple,
@ -57,11 +61,14 @@ import Plutarch.Api.V1 (
PTxInfo (PTxInfo), PTxInfo (PTxInfo),
PTxOut (PTxOut), PTxOut (PTxOut),
PTxOutRef, PTxOutRef,
PValidatorHash,
PValue,
) )
import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.AssocMap (PMap (PMap))
import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Api.V1.Value (PValue (PValue))
import Plutarch.Builtin (ppairDataBuiltin) import Plutarch.Builtin (ppairDataBuiltin)
import Plutarch.Internal (punsafeCoerce) import Plutarch.Internal (punsafeCoerce)
import Plutarch.List (pconvertLists)
import Plutarch.Monadic qualified as P import Plutarch.Monadic qualified as P
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -147,6 +154,15 @@ pfromMaybe = phoistAcyclic $
PJust a' -> a' PJust a' -> a'
PNothing -> e PNothing -> e
-- | Yield True is a given PMaybe is of form PJust _
pisJust :: forall a s. Term s (PMaybe a :--> PBool)
pisJust = phoistAcyclic $
plam $ \v' -> P.do
v <- pmatch v'
case v of
PJust _ -> pconstant True
PNothing -> pconstant False
-- | Escape with a particular value on expecting 'Just'. For use in monadic context. -- | Escape with a particular value on expecting 'Just'. For use in monadic context.
pexpectJust :: pexpectJust ::
forall r a s. forall r a s.
@ -395,20 +411,6 @@ psingletonValue = phoistAcyclic $
res = pcon $ PValue outerTup res = pcon $ PValue outerTup
in res in res
-- | Determine if an address is a script address
pisScriptAddress :: Term s (PAddress :--> PBool)
pisScriptAddress = phoistAcyclic $
plam $ \addr' -> P.do
address <- pletFields @'["credential", "stakingCredential"] addr'
scred <- pmatch $ pfromData address.stakingCredential
case scred of
PDNothing _ -> P.do
cred <- pmatch $ pfromData address.credential
case cred of
PScriptCredential _ -> pconstant True
_ -> pconstant False
_ -> pconstant False
-- | Finds the TxInInfo of an effect from TxInfo and TxOutRef -- | Finds the TxInInfo of an effect from TxInfo and TxOutRef
pfindEffectInput :: Term s (PTxInfo :--> PTxOutRef :--> PTxInInfo) pfindEffectInput :: Term s (PTxInfo :--> PTxOutRef :--> PTxInInfo)
pfindEffectInput = phoistAcyclic $ pfindEffectInput = phoistAcyclic $
@ -423,3 +425,36 @@ pfindEffectAddress :: Term s (PTxInfo :--> PTxOutRef :--> PTxOut)
pfindEffectAddress = phoistAcyclic $ pfindEffectAddress = phoistAcyclic $
plam $ \txInfo spending -> P.do plam $ \txInfo spending -> P.do
pfromData $ pfield @"resolved" #$ pfindEffectInput # txInfo # spending pfromData $ pfield @"resolved" #$ pfindEffectInput # txInfo # spending
-- | Get script hash from an Address.
pscriptHashFromAddress :: Term s (PAddress :--> PMaybe PValidatorHash)
pscriptHashFromAddress = phoistAcyclic $
plam $ \addr -> P.do
cred <- pmatch $ pfromData $ pfield @"credential" # addr
case cred of
PScriptCredential h -> pcon $ PJust $ pfield @"_0" # h
_ -> pcon PNothing
-- | Find all TxOuts sent to an Address
pfindOutputsToAddress :: Term s (PTxInfo :--> PAddress :--> PList PTxOut)
pfindOutputsToAddress = phoistAcyclic $
plam $ \info address' -> P.do
address <- plet $ pdata address'
let outputs = pfromData $ pfield @"outputs" # info
filteredOutputs =
pfilter
# ( plam $ \(pfromData -> txOut) -> P.do
selfAddress <- plet $ pfield @"address" # txOut
selfAddress #== address
)
# outputs
pmap @PList # plam pfromData #$ pconvertLists # filteredOutputs
-- | Find datum in a TxOut
pfindTxOutDatum :: Term s (PTxInfo :--> PTxOut :--> PMaybe PDatum)
pfindTxOutDatum = phoistAcyclic $
plam $ \info out -> P.do
datumHash' <- pmatch $ pfromData $ pfield @"datumHash" # out
case datumHash' of
PDJust ((pfield @"_0" #) -> datumHash) -> pfindDatum # datumHash # info
_ -> pcon PNothing