plutus-contract-1.2.0.0
Safe HaskellNone
LanguageHaskell2010

Wallet.API

Description

Mock wallet implementation

Synopsis

Documentation

submitTxn :: forall effs. Member WalletEffect effs => CardanoTx -> Eff effs () Source #

ownPaymentPubKeyHash :: (Member WalletEffect effs, Member (Error WalletAPIError) effs) => Eff effs PaymentPubKeyHash Source #

Deprecated: Use ownFirstPaymentPubKeyHash, ownPaymentPubKeyHashes or ownAddresses instead

ownPaymentPubKeyHashes :: Member WalletEffect effs => Eff effs [PaymentPubKeyHash] Source #

ownFirstPaymentPubKeyHash :: (Member WalletEffect effs, Member (Error WalletAPIError) effs) => Eff effs PaymentPubKeyHash Source #

ownAddresses :: forall effs. Member WalletEffect effs => Eff effs (NonEmpty CardanoAddress) Source #

balanceTx :: forall effs. Member WalletEffect effs => UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx) Source #

yieldUnbalancedTx :: forall effs. Member WalletEffect effs => UnbalancedTx -> Eff effs () Source #

publishTx :: forall effs. Member NodeClientEffect effs => CardanoTx -> Eff effs () Source #

getClientSlot :: forall effs. Member NodeClientEffect effs => Eff effs Slot Source #

getClientParams :: forall effs. Member NodeClientEffect effs => Eff effs Params Source #

newtype PubKey #

Constructors

PubKey 

Fields

Instances

Instances details
Eq PubKey 
Instance details

Defined in Ledger.Crypto

Ord PubKey 
Instance details

Defined in Ledger.Crypto

Show PubKey 
Instance details

Defined in Ledger.Crypto

IsString PubKey 
Instance details

Defined in Ledger.Crypto

Generic PubKey 
Instance details

Defined in Ledger.Crypto

Associated Types

type Rep PubKey :: Type -> Type Source #

FromJSON PubKey 
Instance details

Defined in Ledger.Crypto

Methods

parseJSON :: Value -> Parser PubKey

parseJSONList :: Value -> Parser [PubKey]

FromJSONKey PubKey 
Instance details

Defined in Ledger.Crypto

Methods

fromJSONKey :: FromJSONKeyFunction PubKey

fromJSONKeyList :: FromJSONKeyFunction [PubKey]

ToJSON PubKey 
Instance details

Defined in Ledger.Crypto

Methods

toJSON :: PubKey -> Value

toEncoding :: PubKey -> Encoding

toJSONList :: [PubKey] -> Value

toEncodingList :: [PubKey] -> Encoding

ToJSONKey PubKey 
Instance details

Defined in Ledger.Crypto

Methods

toJSONKey :: ToJSONKeyFunction PubKey

toJSONKeyList :: ToJSONKeyFunction [PubKey]

Pretty PubKey 
Instance details

Defined in Ledger.Crypto

Methods

pretty :: PubKey -> Doc ann

prettyList :: [PubKey] -> Doc ann

Serialise PubKey 
Instance details

Defined in Ledger.Crypto

Methods

encode :: PubKey -> Encoding

decode :: Decoder s PubKey

encodeList :: [PubKey] -> Encoding

decodeList :: Decoder s [PubKey]

Eq PubKey 
Instance details

Defined in Ledger.Crypto

Methods

(==) :: PubKey -> PubKey -> Bool

FromData PubKey 
Instance details

Defined in Ledger.Crypto

Methods

fromBuiltinData :: BuiltinData -> Maybe PubKey

Ord PubKey 
Instance details

Defined in Ledger.Crypto

ToData PubKey 
Instance details

Defined in Ledger.Crypto

Methods

toBuiltinData :: PubKey -> BuiltinData

UnsafeFromData PubKey 
Instance details

Defined in Ledger.Crypto

Methods

unsafeFromBuiltinData :: BuiltinData -> PubKey

Newtype PubKey 
Instance details

Defined in Ledger.Crypto

Associated Types

type O PubKey

Methods

pack :: O PubKey -> PubKey

unpack :: PubKey -> O PubKey

Lift DefaultUni PubKey 
Instance details

Defined in Ledger.Crypto

Methods

lift :: PubKey -> RTCompile DefaultUni fun (Term TyName Name DefaultUni fun ())

Typeable DefaultUni PubKey 
Instance details

Defined in Ledger.Crypto

Methods

typeRep :: Proxy PubKey -> RTCompile DefaultUni fun (Type TyName DefaultUni ())

type Rep PubKey 
Instance details

Defined in Ledger.Crypto

type Rep PubKey = D1 ('MetaData "PubKey" "Ledger.Crypto" "plutus-ledger-1.2.0.0-8dOSOspdVv7Hd909lHBnfn" 'True) (C1 ('MetaCons "PubKey" 'PrefixI 'True) (S1 ('MetaSel ('Just "getPubKey") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 LedgerBytes)))
type O PubKey 
Instance details

Defined in Ledger.Crypto

type O PubKey = GO (Rep PubKey)

newtype PubKeyHash #

Constructors

PubKeyHash 

Fields

Instances

Instances details
Eq PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Ord PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Show PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

IsString PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Generic PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Associated Types

type Rep PubKeyHash :: Type -> Type Source #

NFData PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

rnf :: PubKeyHash -> () Source #

Pretty PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

pretty :: PubKeyHash -> Doc ann

prettyList :: [PubKeyHash] -> Doc ann

Eq PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

(==) :: PubKeyHash -> PubKeyHash -> Bool

FromData PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

fromBuiltinData :: BuiltinData -> Maybe PubKeyHash

Ord PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

ToData PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

toBuiltinData :: PubKeyHash -> BuiltinData

UnsafeFromData PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

unsafeFromBuiltinData :: BuiltinData -> PubKeyHash

Lift DefaultUni PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

lift :: PubKeyHash -> RTCompile DefaultUni fun (Term TyName Name DefaultUni fun ())

Typeable DefaultUni PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

Methods

typeRep :: Proxy PubKeyHash -> RTCompile DefaultUni fun (Type TyName DefaultUni ())

type Rep PubKeyHash 
Instance details

Defined in Plutus.V1.Ledger.Crypto

type Rep PubKeyHash = D1 ('MetaData "PubKeyHash" "Plutus.V1.Ledger.Crypto" "plutus-ledger-api-1.0.0.1-6EvbyJiK8IAAVEtnIJDu5Z" 'True) (C1 ('MetaCons "PubKeyHash" 'PrefixI 'True) (S1 ('MetaSel ('Just "getPubKeyHash") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 BuiltinByteString)))
type O PubKeyHash 
Instance details

Defined in Ledger.Crypto.Orphans

type O PubKeyHash = GO (Rep PubKeyHash)

signTxAndSubmit :: Member WalletEffect effs => CardanoTx -> Eff effs CardanoTx Source #

Add the wallet's signature to the transaction and submit it. Returns the transaction with the wallet's signature.

signTxAndSubmit_ :: Member WalletEffect effs => CardanoTx -> Eff effs () Source #

A version of signTxAndSubmit that discards the result.

payToAddress :: (Member WalletEffect effs, Member (Error WalletAPIError) effs, Member (LogMsg Text) effs, Member (LogMsg RequestHandlerLogMsg) effs) => Params -> SlotRange -> Value -> Address -> Eff effs CardanoTx Source #

Transfer some funds to an address, returning the transaction that was submitted.

Note: Due to a constraint in the Cardano ledger, each tx output must have a minimum amount of Ada. Therefore, the funds to transfer will be adjusted to satisfy that constraint. See adjustUnbalancedTx.

payToAddress_ :: (Member WalletEffect effs, Member (Error WalletAPIError) effs, Member (LogMsg Text) effs, Member (LogMsg RequestHandlerLogMsg) effs) => Params -> SlotRange -> Value -> Address -> Eff effs () Source #

Transfer some funds to an address.

payToPaymentPublicKeyHash :: (Member WalletEffect effs, Member (Error WalletAPIError) effs, Member (LogMsg Text) effs, Member (LogMsg RequestHandlerLogMsg) effs) => Params -> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs CardanoTx Source #

Transfer some funds to an address locked by a public key, returning the transaction that was submitted.

Note: Due to a constraint in the Cardano ledger, each tx output must have a minimum amount of Ada. Therefore, the funds to transfer will be adjusted to satisfy that constraint. See adjustUnbalancedTx.

payToPaymentPublicKeyHash_ :: (Member WalletEffect effs, Member (Error WalletAPIError) effs, Member (LogMsg Text) effs, Member (LogMsg RequestHandlerLogMsg) effs) => Params -> SlotRange -> Value -> PaymentPubKeyHash -> Eff effs () Source #

Transfer some funds to an address locked by a public key.

data Params #

Constructors

Params 

Fields

Instances

Instances details
Eq Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Show Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Generic Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Associated Types

type Rep Params :: Type -> Type Source #

FromJSON Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Methods

parseJSON :: Value -> Parser Params

parseJSONList :: Value -> Parser [Params]

ToJSON Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Methods

toJSON :: Params -> Value

toEncoding :: Params -> Encoding

toJSONList :: [Params] -> Value

toEncodingList :: [Params] -> Encoding

Pretty Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Methods

pretty :: Params -> Doc ann

prettyList :: [Params] -> Doc ann

Default Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

Methods

def :: Params

type Rep Params 
Instance details

Defined in Cardano.Node.Emulator.Internal.Node.Params

type Rep Params = D1 ('MetaData "Params" "Cardano.Node.Emulator.Internal.Node.Params" "cardano-node-emulator-1.2.0.0-1RjxyDmnwHSAn2KgGdAUXD" 'False) (C1 ('MetaCons "Params" 'PrefixI 'True) (S1 ('MetaSel ('Just "pSlotConfig") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SlotConfig) :*: (S1 ('MetaSel ('Just "emulatorPParams") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 PParams) :*: S1 ('MetaSel ('Just "pNetworkId") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NetworkId))))

Slot ranges

data Interval a #

Constructors

Interval 

Fields

Instances

Instances details
Functor Interval 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

fmap :: (a -> b) -> Interval a -> Interval b

(Typeable DefaultUni a, Lift DefaultUni (LowerBound a), Lift DefaultUni (UpperBound a)) => Lift DefaultUni (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

lift :: Interval a -> RTCompile DefaultUni fun (Term TyName Name DefaultUni fun ())

Eq a => Eq (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

(==) :: Interval a -> Interval a -> Bool Source #

(/=) :: Interval a -> Interval a -> Bool Source #

Ord a => Ord (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Show a => Show (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Generic (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Associated Types

type Rep (Interval a) :: Type -> Type Source #

Methods

from :: Interval a -> Rep (Interval a) x Source #

to :: Rep (Interval a) x -> Interval a Source #

NFData a => NFData (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

rnf :: Interval a -> () Source #

Pretty a => Pretty (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

pretty :: Interval a -> Doc ann

prettyList :: [Interval a] -> Doc ann

Ord a => JoinSemiLattice (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

(\/) :: Interval a -> Interval a -> Interval a

Eq a => Eq (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

(==) :: Interval a -> Interval a -> Bool

FromData a => FromData (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

fromBuiltinData :: BuiltinData -> Maybe (Interval a)

ToData a => ToData (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

toBuiltinData :: Interval a -> BuiltinData

UnsafeFromData a => UnsafeFromData (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

unsafeFromBuiltinData :: BuiltinData -> Interval a

Ord a => BoundedJoinSemiLattice (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

bottom :: Interval a

Ord a => BoundedMeetSemiLattice (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

top :: Interval a

Ord a => MeetSemiLattice (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

(/\) :: Interval a -> Interval a -> Interval a

Typeable DefaultUni Interval 
Instance details

Defined in Plutus.V1.Ledger.Interval

Methods

typeRep :: Proxy Interval -> RTCompile DefaultUni fun (Type TyName DefaultUni ())

type Rep (Interval a) 
Instance details

Defined in Plutus.V1.Ledger.Interval

type Rep (Interval a) = D1 ('MetaData "Interval" "Plutus.V1.Ledger.Interval" "plutus-ledger-api-1.0.0.1-6EvbyJiK8IAAVEtnIJDu5Z" 'False) (C1 ('MetaCons "Interval" 'PrefixI 'True) (S1 ('MetaSel ('Just "ivFrom") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (LowerBound a)) :*: S1 ('MetaSel ('Just "ivTo") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (UpperBound a))))

data Slot #

Instances

Instances details
Enum Slot 
Instance details

Defined in Ledger.Slot

Eq Slot 
Instance details

Defined in Ledger.Slot

Methods

(==) :: Slot -> Slot -> Bool Source #

(/=) :: Slot -> Slot -> Bool Source #

Integral Slot 
Instance details

Defined in Ledger.Slot

Data Slot 
Instance details

Defined in Ledger.Slot

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Slot -> c Slot Source #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Slot Source #

toConstr :: Slot -> Constr Source #

dataTypeOf :: Slot -> DataType Source #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Slot) Source #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Slot) Source #

gmapT :: (forall b. Data b => b -> b) -> Slot -> Slot Source #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r Source #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Slot -> r Source #

gmapQ :: (forall d. Data d => d -> u) -> Slot -> [u] Source #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Slot -> u Source #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Slot -> m Slot Source #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Slot -> m Slot Source #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Slot -> m Slot Source #

Num Slot 
Instance details

Defined in Ledger.Slot

Ord Slot 
Instance details

Defined in Ledger.Slot

Real Slot 
Instance details

Defined in Ledger.Slot

Show Slot 
Instance details

Defined in Ledger.Slot

Generic Slot 
Instance details

Defined in Ledger.Slot

Associated Types

type Rep Slot :: Type -> Type Source #

Methods

from :: Slot -> Rep Slot x Source #

to :: Rep Slot x -> Slot Source #

FromJSON Slot 
Instance details

Defined in Ledger.Slot

Methods

parseJSON :: Value -> Parser Slot

parseJSONList :: Value -> Parser [Slot]

FromJSONKey Slot 
Instance details

Defined in Ledger.Slot

Methods

fromJSONKey :: FromJSONKeyFunction Slot

fromJSONKeyList :: FromJSONKeyFunction [Slot]

ToJSON Slot 
Instance details

Defined in Ledger.Slot

Methods

toJSON :: Slot -> Value

toEncoding :: Slot -> Encoding

toJSONList :: [Slot] -> Value

toEncodingList :: [Slot] -> Encoding

ToJSONKey Slot 
Instance details

Defined in Ledger.Slot

Methods

toJSONKey :: ToJSONKeyFunction Slot

toJSONKeyList :: ToJSONKeyFunction [Slot]

Hashable Slot 
Instance details

Defined in Ledger.Slot

Methods

hashWithSalt :: Int -> Slot -> Int

hash :: Slot -> Int

Pretty Slot 
Instance details

Defined in Ledger.Slot

Methods

pretty :: Slot -> Doc ann

prettyList :: [Slot] -> Doc ann

Serialise Slot 
Instance details

Defined in Ledger.Slot

Methods

encode :: Slot -> Encoding

decode :: Decoder s Slot

encodeList :: [Slot] -> Encoding

decodeList :: Decoder s [Slot]

AdditiveGroup Slot 
Instance details

Defined in Ledger.Slot

Methods

(-) :: Slot -> Slot -> Slot

AdditiveMonoid Slot 
Instance details

Defined in Ledger.Slot

Methods

zero :: Slot

AdditiveSemigroup Slot 
Instance details

Defined in Ledger.Slot

Methods

(+) :: Slot -> Slot -> Slot

Enum Slot 
Instance details

Defined in Ledger.Slot

Eq Slot 
Instance details

Defined in Ledger.Slot

Methods

(==) :: Slot -> Slot -> Bool

FromData Slot 
Instance details

Defined in Ledger.Slot

Methods

fromBuiltinData :: BuiltinData -> Maybe Slot

Ord Slot 
Instance details

Defined in Ledger.Slot

Methods

compare :: Slot -> Slot -> Ordering

(<) :: Slot -> Slot -> Bool

(<=) :: Slot -> Slot -> Bool

(>) :: Slot -> Slot -> Bool

(>=) :: Slot -> Slot -> Bool

max :: Slot -> Slot -> Slot

min :: Slot -> Slot -> Slot

ToData Slot 
Instance details

Defined in Ledger.Slot

Methods

toBuiltinData :: Slot -> BuiltinData

UnsafeFromData Slot 
Instance details

Defined in Ledger.Slot

Methods

unsafeFromBuiltinData :: BuiltinData -> Slot

HasDbType Slot 
Instance details

Defined in Plutus.ChainIndex.DbSchema

Associated Types

type DbType Slot

Methods

toDbValue :: Slot -> DbType Slot

fromDbValue :: DbType Slot -> Slot

Lift DefaultUni Slot 
Instance details

Defined in Ledger.Slot

Methods

lift :: Slot -> RTCompile DefaultUni fun (Term TyName Name DefaultUni fun ())

Typeable DefaultUni Slot 
Instance details

Defined in Ledger.Slot

Methods

typeRep :: Proxy Slot -> RTCompile DefaultUni fun (Type TyName DefaultUni ())

type Rep Slot 
Instance details

Defined in Ledger.Slot

type Rep Slot = D1 ('MetaData "Slot" "Ledger.Slot" "plutus-ledger-1.2.0.0-8dOSOspdVv7Hd909lHBnfn" 'True) (C1 ('MetaCons "Slot" 'PrefixI 'True) (S1 ('MetaSel ('Just "getSlot") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Integer)))
type DbType Slot 
Instance details

Defined in Plutus.ChainIndex.DbSchema

type DbType Slot = Word64

defaultSlotRange :: SlotRange Source #

The default slot validity range for transactions.

interval :: a -> a -> Interval a #

singleton :: a -> Interval a #

isEmpty :: (Enum a, Ord a) => Interval a -> Bool #

member :: Ord a => a -> Interval a -> Bool #

before :: Ord a => a -> Interval a -> Bool #

after :: Ord a => a -> Interval a -> Bool #

contains :: Ord a => Interval a -> Interval a -> Bool #

Error handling

data WalletAPIError Source #

An error thrown by wallet interactions.

Constructors

InsufficientFunds Text

There were insufficient funds to perform the desired operation.

ChangeHasLessThanNAda Value Ada

The change when selecting coins contains less than the minimum amount of Ada.

NoPaymentPubKeyHashError

The wallet doesn't have any payment key hash, which should not be possible.

PaymentPrivateKeyNotFound PaymentPubKeyHash

The private key of this public key hash is not known to the wallet.

ValidationError ValidationError

There was an error during off-chain validation.

ToCardanoError ToCardanoError

There was an error while converting to Cardano.API format.

PaymentMkTxError MkTxError

There was an error while creating a payment transaction

RemoteClientFunctionNotYetSupported Text

The called wallet effect is not yet supported in a remote wallet client scenario.

OtherError Text

Some other error occurred.

Instances

Instances details
Eq WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

Show WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

Generic WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

Associated Types

type Rep WalletAPIError :: Type -> Type Source #

FromJSON WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

Methods

parseJSON :: Value -> Parser WalletAPIError

parseJSONList :: Value -> Parser [WalletAPIError]

ToJSON WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

Methods

toJSON :: WalletAPIError -> Value

toEncoding :: WalletAPIError -> Encoding

toJSONList :: [WalletAPIError] -> Value

toEncodingList :: [WalletAPIError] -> Encoding

Pretty WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

Methods

pretty :: WalletAPIError -> Doc ann

prettyList :: [WalletAPIError] -> Doc ann

type Rep WalletAPIError Source # 
Instance details

Defined in Wallet.Emulator.Error

type Rep WalletAPIError = D1 ('MetaData "WalletAPIError" "Wallet.Emulator.Error" "plutus-contract-1.2.0.0-FH8LC9wh7UV4Nmv68NHXrC" 'False) (((C1 ('MetaCons "InsufficientFunds" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: C1 ('MetaCons "ChangeHasLessThanNAda" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Value) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Ada))) :+: (C1 ('MetaCons "NoPaymentPubKeyHashError" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "PaymentPrivateKeyNotFound" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 PaymentPubKeyHash)))) :+: ((C1 ('MetaCons "ValidationError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ValidationError)) :+: C1 ('MetaCons "ToCardanoError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ToCardanoError))) :+: (C1 ('MetaCons "PaymentMkTxError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 MkTxError)) :+: (C1 ('MetaCons "RemoteClientFunctionNotYetSupported" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)) :+: C1 ('MetaCons "OtherError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))))))

throwInsufficientFundsError :: Member (Error WalletAPIError) effs => Text -> Eff effs a Source #

throwOtherError :: Member (Error WalletAPIError) effs => Text -> Eff effs a Source #