More utility functions
functions that I missed from Conner's governor branch...
This commit is contained in:
parent
458ce8b453
commit
0090299146
1 changed files with 51 additions and 16 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue