Merge pull request #586 from input-output-hk/PLT-5901 PLT-5901 Implemented check… - input-output-hk/marlowe-cardano@289546c3 - Cardano Updates

Home / Input Output / marlowe-cardano / 289546c3

View on GitHub

File Changes

a

marlowe-runtime/changelog.d/20230602_132507_brian.bush_PLT_5901.md

+3/-0

+

### Added

+

+

- Safety checks for invalid Plutus addresses.

m

marlowe-runtime/test/Language/Marlowe/Runtime/Transaction/SafetySpec.hs

+42/-8

import qualified Data.Map.Strict as M (fromList, keys, lookup, mapKeys, toList)

import Language.Marlowe.Core.V1.Merkle as V1 (MerkleizedContract(..), deepMerkleize, merkleizedContract)

import qualified Language.Marlowe.Core.V1.Semantics.Types as V1

+

import qualified Language.Marlowe.Core.V1.Semantics.Types.Address as V1

import qualified Language.Marlowe.Runtime.Cardano.Api as Chain

  (assetsToCardanoValue, fromCardanoAddressInEra, toCardanoAddressAny, toCardanoDatumHash, toCardanoPaymentCredential)

import qualified Language.Marlowe.Runtime.ChainSync.Api as Chain

  (AssetId(..), Assets(..), Credential(..), DatumHash(..), PolicyId(..), TokenName(..), Tokens(..))

-

import qualified Plutus.V2.Ledger.Api as Plutus (CurrencySymbol(..), DatumHash(..), TokenName(..))

+

import qualified Plutus.V2.Ledger.Api as Plutus

+

  (Address(..), Credential(..), CurrencySymbol(..), DatumHash(..), TokenName(..))

import qualified PlutusTx.Builtins as Plutus (fromBuiltin, lengthOfByteString, toBuiltin)

import Test.QuickCheck.Arbitrary (arbitrary)

do

let

+

      testnet = Cardano.Testnet $ Cardano.NetworkMagic 1

      version = MarloweV1

      continuations = noContinuations version

      party = V1.Role "x"

        prop "Contract without roles" $ \roleTokensConfig ->

let

            contract = V1.Close

-

            actual = checkContract roleTokensConfig version contract continuations

+

            actual = checkContract testnet roleTokensConfig version contract continuations

in

            counterexample ("Contract = " <> show contract)

              $ case roleTokensConfig of

let

                roles = Plutus.TokenName . Plutus.toBuiltin . Chain.unTokenName <$> M.keys (unMint mint)

                contract = foldr payRole V1.Close roles

-

                actual = checkContract roleTokensConfig version contract continuations

+

                actual = checkContract testnet roleTokensConfig version contract continuations

in

                counterexample ("Contract = " <> show contract)

                  $ actual === mempty

let

                roles = Plutus.TokenName . Plutus.toBuiltin . Chain.unTokenName <$> M.keys (unMint mint)

                contract = foldr payRole V1.Close $ extra <> roles

-

                actual = checkContract roleTokensConfig version contract continuations

+

                actual = checkContract testnet roleTokensConfig version contract continuations

                expected =

                  (MissingRoleToken <$> nub extra)

                    <> [RoleNameTooLong role | role@(Plutus.TokenName name) <- nub extra, Plutus.lengthOfByteString name > 32]

let

                  extra = filter (`notElem` roles) roles'

                  contract = foldr payRole V1.Close roles

-

                  actual = checkContract roleTokensConfig version contract continuations

+

                  actual = checkContract testnet roleTokensConfig version contract continuations

                  expected = ExtraRoleToken <$> extra

                pure

                  . counterexample ("Contract = " <> show contract)

        prop "Contract with role name too long" $ \roles ->

let

            contract = foldr payRole V1.Close roles

-

            actual = checkContract (RoleTokensUsePolicy "") version contract continuations

+

            actual = checkContract testnet (RoleTokensUsePolicy "") version contract continuations

            expected =

              if null roles

                then [ContractHasNoRoles]

        prop "Contract with illegal token" $ \tokens ->

let

            contract = foldr payToken V1.Close tokens

-

            actual = checkContract (RoleTokensUsePolicy "") version contract continuations

+

            actual = checkContract testnet (RoleTokensUsePolicy "") version contract continuations

            expected =

              if contract == V1.Close

                then [ContractHasNoRoles]

              relevant (InvalidCurrencySymbol _) = False

              relevant (TokenNameTooLong _) = False

              relevant _ = True

-

              actual = filter relevant $ checkContract (RoleTokensUsePolicy "") version mcContract (M.fromList remaining)

+

              actual = filter relevant $ checkContract testnet (RoleTokensUsePolicy "") version mcContract (M.fromList remaining)

              expected = MissingContinuation . Plutus.DatumHash . Plutus.toBuiltin . Chain.unDatumHash . fst <$> missing

            pure . counterexample ("Contract = " <> show mcContract)

              . counterexample ("Missing = " <> show missing)

              . counterexample ("Remaining = " <> show remaining)

              . counterexample ("Actual = " <> show actual)

              . counterexample ("Expected = " <> show expected)

              $ actual `same` expected

+

        prop "Contract with inconsistent networks" $ \address ->

+

do

+

let

+

              contract = V1.When [V1.Case (V1.Deposit (V1.Address True address) (V1.Address False address) (V1.Token "" "") (V1.Constant 1)) V1.Close] 0 V1.Close

+

              actual = checkContract testnet RoleTokensNone version contract mempty

+

              expected = [InconsistentNetworks, WrongNetwork]

+

            counterexample ("Actual = " <> show actual)

+

              . counterexample ("Expected = " <> show expected)

+

              $ actual `same` expected

+

        prop "Contract on wrong network" $ \address ->

+

do

+

let

+

              contract = V1.When [V1.Case (V1.Choice (V1.ChoiceId "Choice" $ V1.Address V1.mainnet address) [] ) V1.Close] 0 V1.Close

+

              actual = checkContract testnet RoleTokensNone version contract mempty

+

              expected = [WrongNetwork]

+

            counterexample ("Actual = " <> show actual)

+

              . counterexample ("Expected = " <> show expected)

+

              $ actual `same` expected

+

        prop "Contract with bad address"

+

do

+

let

+

              address =

+

                Plutus.Address

+

                 (Plutus.PubKeyCredential "0000000000000000000000000000000000000000000000000000000000000000") -- The hash is too long.

+

                 Nothing

+

              contract = V1.When [V1.Case (V1.Choice (V1.ChoiceId "Choice" $ V1.Address False address) [] ) V1.Close] 0 V1.Close

+

              actual = checkContract testnet RoleTokensNone version contract mempty

+

              expected = [IllegalAddress address]

+

            counterexample ("Actual = " <> show actual)

+

              . counterexample ("Expected = " <> show expected)

+

              $ actual `same` expected

    describe "checkTransactions" do

      referenceContracts <- runIO readReferenceContracts

m

marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Safety.hs

+13/-7

import Data.String (fromString)

import Data.Time (UTCTime, addUTCTime, secondsToNominalDiffTime)

import Data.Time.Clock.POSIX (posixSecondsToUTCTime)

-

import Language.Marlowe.Analysis.Safety.Ledger (checkContinuations, checkRoleNames, checkTokens, worstMinimumUtxo')

+

import Language.Marlowe.Analysis.Safety.Ledger

+

  (checkAddresses, checkContinuations, checkNetwork, checkNetworks, checkRoleNames, checkTokens, worstMinimumUtxo')

import Language.Marlowe.Analysis.Safety.Transaction (findTransactions)

import Language.Marlowe.Analysis.Safety.Types (SafetyError(..), Transaction(..))

import Language.Marlowe.Runtime.Core.Api

  , WalletContext(..)

-

import qualified Cardano.Api as Cardano (Lovelace)

+

import qualified Cardano.Api as Cardano (Lovelace, NetworkId(Mainnet))

import qualified Cardano.Api.Shelley as Shelley

  ( CardanoMode

  , ConsensusMode(..)

-- | Check a contract for design errors and ledger violations.

checkContract

-

  :: RoleTokensConfig

+

  :: Cardano.NetworkId

+

  -> RoleTokensConfig

  -> MarloweVersion v

  -> Contract v

  -> Continuations v

  -> [SafetyError]

-

checkContract config MarloweV1 contract continuations =

+

checkContract network config MarloweV1 contract continuations =

let

    continuations' = remapContinuations continuations

    roles = toList $ V1.extractAllWithContinuations contract continuations'

                                          missing <> extra

        _                            -> mempty

    avoidDuplicateReport = True

-

    nameCheck = checkRoleNames avoidDuplicateReport contract continuations'

-

    tokenCheck = checkTokens contract continuations'

+

    nameCheck = checkRoleNames avoidDuplicateReport Nothing contract continuations'

+

    tokenCheck = checkTokens Nothing contract continuations'

    continuationCheck = checkContinuations contract continuations'

+

    networksCheck =

+

      checkNetwork (network == Cardano.Mainnet) Nothing contract continuations'

+

        <> snd (checkNetworks Nothing contract continuations')

+

    addressCheck = checkAddresses Nothing contract continuations'

in

-

    mintCheck <> nameCheck <> tokenCheck <> continuationCheck

+

    mintCheck <> nameCheck <> tokenCheck <> continuationCheck <> networksCheck <> addressCheck

-- | Mock-execute all possible transactions for a contract.

m

marlowe-runtime/tx/Language/Marlowe/Runtime/Transaction/Server.hs

+1/-1

let

    contractSafetyErrors =

      if False  -- FIXME: Disabled because of incompatibility with integration tests.

-

        then checkContract roleTokens version contract' continuations

+

        then checkContract networkId roleTokens version contract' continuations

        else mempty

  -- FIXME: The is a placeholder until we design safety-analysis reporting.

  unless (null contractSafetyErrors)

a

marlowe-test/changelog.d/20230602_132224_brian.bush_PLT_5901.rst

+4/-0

+

Added

+

-----

+

+

- Property-based tests for safety checks on Plutus addresses.

m

marlowe-test/src/Spec/Marlowe/Semantics/Arbitrary.hs

+2/-1

  , ValueId(..)

  , getAction

+

import Language.Marlowe.Core.V1.Semantics.Types.Address (testnet)

import Plutus.Script.Utils.Scripts (dataHash)

import Plutus.V2.Ledger.Api

  ( Credential(..)

instance Arbitrary Party where

  arbitrary = frequency

-

    [ (1, Address <$> arbitrary <*> arbitrary)

+

    [ (1, Address testnet <$> arbitrary)

    , (4, Role <$> arbitraryFibonacci randomRoleNames)

  shrink (Address _ _) = []

a

marlowe/changelog.d/20230602_132119_brian.bush_PLT_5901.md

+3/-0

+

### Added

+

+

- Safety checks for valid Plutus addresses.

m

marlowe/src/Language/Marlowe/Analysis/Safety/Ledger.hs

+88/-21

module Language.Marlowe.Analysis.Safety.Ledger

  ( -- * Checks for Contracts

-

    checkContinuations

+

    checkAddress

+

  , checkAddresses

+

  , checkContinuations

  , checkMaximumValueBound

+

  , checkNetwork

+

  , checkNetworks

  , checkRoleNames

  , checkSafety

  , checkTokens

import Data.Maybe (fromJust)

import Language.Marlowe.Analysis.Safety.Types (SafetyError(..), SafetyReport(..))

import Language.Marlowe.Core.V1.Merkle (Continuations)

-

import Language.Marlowe.Core.V1.Plate (Extract, extractAllWithContinuations)

+

import Language.Marlowe.Core.V1.Plate

+

  (Extract, extractAddresses, extractAllWithContinuations, extractNetworks, extractRoleNames, extractTokens)

import Language.Marlowe.Core.V1.Semantics (MarloweData(..), MarloweParams(..))

import Language.Marlowe.Core.V1.Semantics.Types

  (Action(..), Bound(..), Case(..), Contract, InputContent(..), State(..), Token(..), emptyState)

+

import Language.Marlowe.Core.V1.Semantics.Types.Address

+

  (Network, deserialiseAddressBech32, mainnet, serialiseAddressBech32, testnet)

import Language.Marlowe.Scripts (MarloweTxInput(..))

import Numeric.Natural (Natural)

import Plutus.V2.Ledger.Api

import PlutusTx.Builtins (serialiseData)

import qualified Data.Map as M (keys)

-

import qualified Data.Set as S (Set, filter, fromList, map, null, size, toList)

+

import qualified Data.Set as S (Set, filter, foldr, map, null, size, toList)

import qualified Plutus.V1.Ledger.Value as V (singleton)

import qualified Plutus.V2.Ledger.Api as P (Address(..), Value)

import qualified PlutusTx.AssocMap as AM (Map, fromList, keys, toList)

  -> SafetyReport  -- ^ The report on the contract's safety.

checkSafety maxValueSize utxoCostPerByte MarloweData{..} continuations =

let

+

    state' = Just marloweState

+

    (networks, networkCheck) = checkNetworks state' marloweContract continuations

    safetyErrors =

-

         checkRoleNames (rolesCurrency marloweParams /= adaSymbol) marloweContract continuations

-

      <> checkTokens marloweContract continuations

-

      <> checkMaximumValueBound maxValueSize marloweState marloweContract continuations

+

         checkRoleNames (rolesCurrency marloweParams /= adaSymbol) state' marloweContract continuations

+

      <> checkTokens state' marloweContract continuations

+

      <> checkMaximumValueBound maxValueSize state' marloweContract continuations

      <> checkPositiveBalance marloweState

      <> checkDuplicates marloweState

      <> checkContinuations marloweContract continuations

+

      <> networkCheck

    boundOnMinimumUtxo = worstMinimumUtxo utxoCostPerByte marloweState marloweContract continuations

    boundOnDatumSize = worstDatumSize marloweParams marloweContract continuations

    boundOnRedeemerSize = worstRedeemerSize marloweContract continuations

in

    SafetyReport{..}

+

-- | Check a contract for consistency with the network where it will be run.

+

checkNetwork

+

  :: Bool  -- ^ Whether the network is mainnet.

+

  -> Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The merkleized continuations of the contract.

+

  -> [SafetyError]  -- ^ A safety error if the network is incorrect.

+

checkNetwork isMainnet state contract continuations =

+

let

+

    networks = S.toList $ extractNetworks state contract continuations

+

    target

+

      | isMainnet = mainnet

+

      | otherwise = testnet

+

in

+

    if all (== target) networks

+

      then mempty

+

      else pure WrongNetwork

+

+

+

-- | Check that networks are consistently used in a contract.

+

checkNetworks

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The merkleized continuations of the contract.

+

  -> ([Network], [SafetyError])  -- ^ The networks present in the contract, and any network errors.

+

checkNetworks state contract continuations =

+

let

+

    networks = S.toList $ extractNetworks state contract continuations

+

in

+

+

      networks

+

    , if length networks > 1

+

        then pure InconsistentNetworks

+

        else mempty

+

+

+

+

-- | Check that an address can be serialized round trip.

+

checkAddress

+

  :: P.Address  -- ^ The address.

+

  -> [SafetyError]  -- ^ Any safety error for the address.

+

checkAddress address =

+

  case deserialiseAddressBech32 $ serialiseAddressBech32 False address of

+

    Nothing -> pure $ IllegalAddress address

+

    Just _ -> mempty

+

+

+

-- | Check that all addresses can be serialized round trip.

+

checkAddresses

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The merkleized continuations of the contract.

+

  -> [SafetyError]  -- ^ Any safety errors for the addresses in the contract.

+

checkAddresses state contract =

+

nub

+

    . S.foldr ((<>) . checkAddress) mempty

+

    . extractAddresses state contract

+

+

-- | Check that all continuations are present.

checkContinuations

  :: Contract  -- ^ The contract.

-- | Check that role names are not too long, and that roles are not present if a roles currency is not specified.

checkRoleNames

  :: Bool  -- ^ Whether the contract has a roles currency.

+

  -> Maybe State  -- ^ The initial state.

  -> Contract  -- ^ The contract.

  -> Continuations  -- ^ The merkleized continuations.

  -> [SafetyError]  -- ^ The safety messages.

-

checkRoleNames hasRolesCurrency contract continuations =

+

checkRoleNames hasRolesCurrency state contract continuations =

let

-

    roles = extractAllWithContinuations contract continuations

+

    roles = extractRoleNames state contract continuations

    invalidRole TokenName{..} = P.lengthOfByteString unTokenName > 32

in

    if hasRolesCurrency || S.null roles

-- | Check that a contract has native tokens satisfying the ledger rules.

checkTokens

-

  :: Contract  -- ^ The contract.

+

  :: Maybe State  -- ^ The initial state.

+

  -> Contract  -- ^ The contract.

  -> Continuations  -- ^ The merkleized continuations.

  -> [SafetyError]  -- ^ The safety messages.

checkTokens =

      | P.lengthOfByteString unTokenName > 32 = pure $ TokenNameTooLong name

      | otherwise = mempty

in

-

   ((nub . foldMap invalidToken . toList) .) . extractAllWithContinuations

+

   (((nub . foldMap invalidToken . toList) .) .) . extractTokens

-- | Check that a contract satisfies the maximum value ledger constraint.

checkMaximumValueBound

  :: Natural  -- ^ The `maxValueSize` protocol parameter.

-

  -> State  -- ^ The initial state.

+

  -> Maybe State  -- ^ The initial state.

  -> Contract  -- ^ The contract.

  -> Continuations  -- ^ The merkleized continuations.

  -> [SafetyError]  -- ^ The safety messages.

-- | Compute a bound on the value size for a contract.

worstMaximumValue

-

  :: State  -- ^ The initial state.

+

  :: Maybe State  -- ^ The initial state.

  -> Contract  -- ^ The contract.

  -> Continuations  -- ^ The merkleized continuations.

  -> Natural  -- ^ A bound on the value size (in bytes).

-

worstMaximumValue State{accounts} =

-

let

-

    initial = S.fromList $ snd <$> AM.keys accounts

-

in

-

    ((worstValueSize . (initial <>)) .)

-

      . extractAllWithContinuations

+

worstMaximumValue =

+

  ((worstValueSize .) .) . extractTokens

-- | Find a representative value with worst-case size.

             . toInteger

             $ fromInteger utxoCostPerByte *

-

                 27 * 8                                          -- Worst case for stake address and ada.

-

               + worstMaximumValue state contract continuations  -- Worst case for size of value.

-

               + 10 * 8                                          -- Worst case for length of datum hash.

+

                 27 * 8                                                 -- Worst case for stake address and ada.

+

               + worstMaximumValue (Just state) contract continuations  -- Worst case for size of value.

+

               + 10 * 8                                                 -- Worst case for length of datum hash.

             )  -- This assumes that the size computed for the Alonzo era serves as an upper-bound for future eras.

m

marlowe/src/Language/Marlowe/Analysis/Safety/Types.hs

+9/-0

import Data.Aeson (ToJSON(..), object, (.=))

import Language.Marlowe.Core.V1.Semantics (TransactionInput, TransactionOutput)

import Language.Marlowe.Core.V1.Semantics.Types (AccountId, ChoiceId, Contract, State, Token, ValueId)

+

import Language.Marlowe.Core.V1.Semantics.Types.Address (Network)

import Numeric.Natural (Natural)

import Plutus.V2.Ledger.Api (CurrencySymbol, DatumHash, ExBudget, TokenName)

import qualified Language.Marlowe.Core.V1.Semantics as V1 (TransactionWarning)

+

import qualified Plutus.V2.Ledger.Api as Ledger (Address)

-- | Information on the safety of a Marlowe contract and state.

  , boundOnMinimumUtxo :: Maybe Integer  -- ^ A bound on the minimum-UTxO value, over all execution paths.

  , boundOnDatumSize :: Natural  -- ^ A bound (in bytes) on the size of the datum, over all execution paths.

  , boundOnRedeemerSize :: Natural  -- ^ A bound (in bytes) on the size of the redeemer, over all execution paths.

+

  , networks :: [Network]  -- ^ Which network the contract must use.

    deriving Show

  | TransactionWarning V1.TransactionWarning

    -- | The contract is missing a continuation not present in its continuation map.

  | MissingContinuation DatumHash

+

    -- | The contract contains both mainnet and testnet addresses.

+

  | InconsistentNetworks

+

    -- | The contract contains invalid addresses for the network.

+

  | WrongNetwork

+

    -- | The contract contains an illegal ledger address.

+

  | IllegalAddress Ledger.Address

    deriving (Eq, Show)

m

marlowe/src/Language/Marlowe/Core/V1/Plate.hs

+124/-4

{-# LANGUAGE FlexibleInstances #-}

{-# LANGUAGE MultiParamTypeClasses #-}

+

{-# LANGUAGE RecordWildCards #-}

module Language.Marlowe.Core.V1.Plate

  ( Extract(..)

  , MarlowePlate(..)

+

  , StateExtract(..)

+

  , extractAddresses

  , extractAllWithContinuations

+

  , extractNetworkAddresses

+

  , extractNetworks

+

  , extractRoleNames

+

  , extractTokens

  ) where

import Data.Generics.Multiplate (Multiplate(..), foldFor, mChildren, preorderFold, purePlate)

+

import Data.Maybe (mapMaybe)

import Language.Marlowe.Core.V1.Merkle (Continuations)

import Language.Marlowe.Core.V1.Semantics.Types

+

import Language.Marlowe.Core.V1.Semantics.Types.Address (Network)

import Plutus.V1.Ledger.Api (BuiltinByteString, TokenName)

import qualified Data.Functor.Constant as F (Constant(..))

import qualified Data.Map.Strict as M (foldr)

-

import qualified Data.Set as S (Set, empty, fromList, singleton, union)

+

import qualified Data.Set as S (Set, empty, fromList, map, singleton, toList, union)

+

import qualified Plutus.V2.Ledger.Api as Ledger (Address)

+

import qualified PlutusTx.AssocMap as AM (keys)

-- | A mutltiplate for a Marlowe contract.

      , valuePlate = valuePlate'

-

instance Extract (AccountId, Token) where

  extractor =

let

      , valuePlate = valuePlate'

-

instance Extract (Case Contract) where

  extractor =

let

        contractPlate = contractPlate'

-

instance Extract BuiltinByteString where

  extractor =

let

        casePlate = casePlate'

+

instance Extract Party where

+

  extractor =

+

let

+

      contractPlate' (Pay p (Party p') _ _ _) = F.Constant $ S.fromList [p, p']

+

      contractPlate' x = pure x

+

      actionPlate' (Deposit p p' _ _) = F.Constant $ S.fromList [p, p']

+

      actionPlate' (Choice (ChoiceId _ p) _) = F.Constant $ S.singleton p

+

      actionPlate' x = pure x

+

      valuePlate' (AvailableMoney p _) = F.Constant $ S.singleton p

+

      valuePlate' (ChoiceValue (ChoiceId _ p)) = F.Constant $ S.singleton p

+

      valuePlate' x = pure x

+

      observationPlate' (ChoseSomething (ChoiceId _ p)) = F.Constant $ S.singleton p

+

      observationPlate' x = pure x

+

in

+

      purePlate

+

+

        contractPlate = contractPlate'

+

      , actionPlate = actionPlate'

+

      , valuePlate = valuePlate'

+

      , observationPlate = observationPlate'

+

+

-- | Extract something from a Marlowe contract.

extractAllWithContinuations

  -> Continuations  -- ^ The continuations of the contract.

  -> S.Set a        -- ^ The extract.

extractAllWithContinuations = M.foldr (S.union . extractAll) . extractAll

+

+

+

-- | Class for extracting information from a contract's state.

+

class StateExtract a where

+

  -- | Extract information from a contract's state.

+

  extractFromState

+

    :: State  -- ^ The state.

+

    -> S.Set a  -- ^ The information.

+

+

instance StateExtract Party where

+

  extractFromState State{..} =

+

let

+

      fromChoice (ChoiceId _ p) = p

+

in

+

      S.fromList

+

        $ (fst <$> AM.keys accounts)

+

        <> (fromChoice <$> AM.keys choices)

+

+

instance StateExtract Token where

+

  extractFromState State{..} =

+

    S.fromList

+

      $ snd <$> AM.keys accounts

+

+

+

-- | List all of the parties in a contract and its state.

+

extractParties

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The contract's merkleized continuations.

+

  -> S.Set Party  -- ^ The parties.

+

extractParties state contract continuations =

+

  maybe mempty extractFromState state

+

    <> extractAllWithContinuations contract continuations

+

+

+

-- | List all of the parties in a contract and its state.

+

extractRoleNames

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The contract's merkleized continuations.

+

  -> S.Set TokenName  -- ^ The tokens.

+

extractRoleNames =

+

let

+

    role (Role name) = Just name

+

    role _ = Nothing

+

in

+

    (((S.fromList . mapMaybe role . S.toList) .) .) . extractParties

+

+

+

-- | List all of the network addresses in a contract and its state.

+

extractNetworkAddresses

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The contract's merkleized continuations.

+

  -> S.Set (Network, Ledger.Address)  -- ^ The network addresses.

+

extractNetworkAddresses =

+

let

+

    address (Address n a) = Just (n, a)

+

    address _ = Nothing

+

in

+

    (((S.fromList . mapMaybe address . S.toList) .) .) . extractParties

+

+

+

-- | List all of the networks in a contract and its state.

+

extractNetworks

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The contract's merkleized continuations.

+

  -> S.Set Network  -- ^ The networks.

+

extractNetworks = ((S.map fst .) .) . extractNetworkAddresses

+

+

+

-- | List all of the addresses in a contract and its state.

+

extractAddresses

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The contract's merkleized continuations.

+

  -> S.Set Ledger.Address  -- ^ The addresses.

+

extractAddresses = ((S.map snd .) .) . extractNetworkAddresses

+

+

+

-- | List all of the tokens in a contract and its state.

+

extractTokens

+

  :: Maybe State  -- ^ The contract's initial state.

+

  -> Contract  -- ^ The contract.

+

  -> Continuations  -- ^ The contract's merkleized continuations.

+

  -> S.Set Token  -- ^ The tokens.

+

extractTokens state contract continuations =

+

  maybe mempty extractFromState state

+

    <> extractAllWithContinuations contract continuations

m

marlowe/src/Language/Marlowe/Scripts.hs

+0/-1

{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}

{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-}

-

{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:dump-uplc #-}

{-# OPTIONS_GHC -Wno-name-shadowing #-}

Yesterday's Report

Wednesday, September 20, 2023

727 commits in 72 repos

New Repo Discovered

Wed, 20 Sep 23 12:04:09 +0000 · aiken-mode

Emacs Lisp · MPL-2.0

New Releases

Wed, 20 Sep 23 17:14:01 +0000 · v1.0.17-alpha aiken Wed, 20 Sep 23 17:00:12 +0000 · Unstable Development Builds mithril Wed, 20 Sep 23 16:12:11 +0000 · @cardano-sdk/[email protected] cardano-js-sdk Wed, 20 Sep 23 14:24:04 +0000 · Open Enterprise Agent v1.16.0 open-enterprise-agent Wed, 20 Sep 23 14:24:04 +0000 · Open Enterprise Agent v1.16.0 atala-prism-building-blocks Wed, 20 Sep 23 14:12:47 +0000 · Cardano Node 8.4.0-pre cardano-node

3,495 commits this week Sep 14, 2023 - Sep 21, 2023

Showing 25 of 3495 recent commits.