Merge pull request #58 from Liqwid-Labs/seunghoenoh/util
New utility functions
This commit is contained in:
commit
35e59a46ed
1 changed files with 56 additions and 0 deletions
|
|
@ -26,12 +26,17 @@ module Agora.Utils (
|
|||
psingletonValue,
|
||||
pfindMap,
|
||||
pnotNull,
|
||||
pisJust,
|
||||
|
||||
-- * Functions which should (probably) not be upstreamed
|
||||
anyOutput,
|
||||
allOutputs,
|
||||
anyInput,
|
||||
allInputs,
|
||||
findTxOutByTxOutRef,
|
||||
scriptHashFromAddress,
|
||||
findOutputsToAddress,
|
||||
findTxOutDatum,
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -42,9 +47,11 @@ import Plutus.V1.Ledger.Value (AssetClass (..))
|
|||
|
||||
import Plutarch.Api.V1 (
|
||||
PAddress,
|
||||
PCredential (PScriptCredential),
|
||||
PCurrencySymbol,
|
||||
PDatum,
|
||||
PDatumHash,
|
||||
PMap,
|
||||
PMaybeData (PDJust),
|
||||
PPubKeyHash,
|
||||
PTokenName,
|
||||
|
|
@ -53,6 +60,8 @@ import Plutarch.Api.V1 (
|
|||
PTxInfo (PTxInfo),
|
||||
PTxOut (PTxOut),
|
||||
PTxOutRef,
|
||||
PValidatorHash,
|
||||
PValue,
|
||||
)
|
||||
import Plutarch.Api.V1.AssocMap (PMap (PMap))
|
||||
import Plutarch.Api.V1.Value (PValue (PValue))
|
||||
|
|
@ -143,6 +152,15 @@ pfromMaybe = phoistAcyclic $
|
|||
PJust a' -> a'
|
||||
PNothing -> e
|
||||
|
||||
-- | Yield True if 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.
|
||||
pexpectJust ::
|
||||
forall r a s.
|
||||
|
|
@ -390,3 +408,41 @@ psingletonValue = phoistAcyclic $
|
|||
outerTup = pcon $ PMap $ psingleton #$ ppairDataBuiltin # pdata sym # pdata innerTup
|
||||
res = pcon $ PValue outerTup
|
||||
in res
|
||||
|
||||
-- | Finds the TxOut of an effect from TxInfo and TxOutRef
|
||||
findTxOutByTxOutRef :: Term s (PTxOutRef :--> PTxInfo :--> PMaybe PTxOut)
|
||||
findTxOutByTxOutRef = phoistAcyclic $
|
||||
plam $ \txOutRef txInfo ->
|
||||
pmatch (pfindTxInByTxOutRef # txOutRef # txInfo) $ \case
|
||||
PJust ((pfield @"resolved" #) -> txOut) -> pcon $ PJust txOut
|
||||
PNothing -> pcon PNothing
|
||||
|
||||
-- | Get script hash from an Address.
|
||||
scriptHashFromAddress :: Term s (PAddress :--> PMaybe PValidatorHash)
|
||||
scriptHashFromAddress = phoistAcyclic $
|
||||
plam $ \addr ->
|
||||
pmatch (pfromData $ pfield @"credential" # addr) $ \case
|
||||
PScriptCredential ((pfield @"_0" #) -> h) -> pcon $ PJust h
|
||||
_ -> pcon PNothing
|
||||
|
||||
-- | Find all TxOuts sent to an Address
|
||||
findOutputsToAddress :: Term s (PTxInfo :--> PAddress :--> PBuiltinList (PAsData PTxOut))
|
||||
findOutputsToAddress = phoistAcyclic $
|
||||
plam $ \info address' -> P.do
|
||||
address <- plet $ pdata address'
|
||||
let outputs = pfromData $ pfield @"outputs" # info
|
||||
filteredOutputs =
|
||||
pfilter
|
||||
# plam
|
||||
(\(pfromData -> txOut) -> pfield @"address" # txOut #== address)
|
||||
# outputs
|
||||
filteredOutputs
|
||||
|
||||
-- | Find the data corresponding to a TxOut, if there is one
|
||||
findTxOutDatum :: Term s (PTxInfo :--> PTxOut :--> PMaybe PDatum)
|
||||
findTxOutDatum = 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