| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Wallet.Emulator.Wallet
Contents
Synopsis
- newtype SigningProcess = SigningProcess {
- unSigningProcess :: forall effs. Member (Error WalletAPIError) effs => [PaymentPubKeyHash] -> CardanoTx -> Eff effs CardanoTx
- data Wallet = Wallet {}
- toMockWallet :: MockWallet -> Wallet
- knownWallets :: [Wallet]
- knownWallet :: Integer -> Wallet
- fromWalletNumber :: WalletNumber -> Wallet
- newtype WalletId = WalletId {}
- toBase16 :: WalletId -> Text
- fromBase16 :: Text -> Either String WalletId
- walletToMockWallet :: Wallet -> Maybe MockWallet
- walletToMockWallet' :: Wallet -> MockWallet
- mockWalletPaymentPubKey :: Wallet -> PaymentPubKey
- mockWalletPaymentPubKeyHash :: Wallet -> PaymentPubKeyHash
- mockWalletAddress :: Wallet -> CardanoAddress
- data WalletEvent
- _TxBalanceLog :: Prism' WalletEvent TxBalanceMsg
- _RequestHandlerLog :: Prism' WalletEvent RequestHandlerLogMsg
- _CheckpointLog :: Prism' WalletEvent CheckpointLogMsg
- _GenericLog :: Prism' WalletEvent Text
- data WalletState = WalletState {}
- signingProcess :: Lens' WalletState (Maybe SigningProcess)
- nodeClient :: Lens' WalletState NodeClientState
- mockWallet :: Lens' WalletState MockWallet
- chainIndexEmulatorState :: Lens' WalletState ChainIndexEmulatorState
- ownPaymentPrivateKey :: WalletState -> PaymentPrivateKey
- ownPaymentPublicKey :: WalletState -> PaymentPubKey
- ownAddress :: WalletState -> CardanoAddress
- fromMockWallet :: MockWallet -> WalletState
- emptyWalletState :: Wallet -> Maybe WalletState
- handleWallet :: (Member (Error WalletAPIError) effs, Member NodeClientEffect effs, Member ChainIndexQueryEffect effs, Member (State WalletState) effs, Member (LogMsg TxBalanceMsg) effs) => WalletEffect ~> Eff effs
- handleBalance :: (Member NodeClientEffect effs, Member ChainIndexQueryEffect effs, Member (State WalletState) effs, Member (LogMsg TxBalanceMsg) effs, Member (Error WalletAPIError) effs) => UnbalancedTx -> Eff effs CardanoTx
- handleAddSignature :: (Member (State WalletState) effs, Member (Error WalletAPIError) effs) => CardanoTx -> Eff effs CardanoTx
- ownOutputs :: forall effs. Member ChainIndexQueryEffect effs => WalletState -> Eff effs (Map TxOutRef DecoratedTxOut)
- defaultSigningProcess :: MockWallet -> SigningProcess
- signWithPrivateKey :: PaymentPrivateKey -> SigningProcess
- signWallet :: MockWallet -> SigningProcess
- signTxnWithKey :: Member (Error WalletAPIError) r => MockWallet -> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
- signTxWithPrivateKey :: Member (Error WalletAPIError) r => PaymentPrivateKey -> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx
- signPrivateKeys :: [PaymentPrivateKey] -> SigningProcess
- data SigningProcessControlEffect r where
- setSigningProcess :: forall effs. Member SigningProcessControlEffect effs => Maybe SigningProcess -> Eff effs ()
- type SigningProcessEffs = '[State (Maybe SigningProcess), Error WalletAPIError]
- handleSigningProcessControl :: Members SigningProcessEffs effs => Eff (SigningProcessControlEffect ': effs) ~> Eff effs
- data Entity
- type WalletSet = Map Wallet WalletState
- walletPaymentPubKeyHashes :: WalletSet -> Map PaymentPubKeyHash Wallet
- balances :: ChainState -> WalletSet -> Map Entity Value
Documentation
newtype SigningProcess Source #
Constructors
| SigningProcess | |
Fields
| |
Instances
| Show SigningProcess Source # | |
Defined in Wallet.Emulator.Wallet | |
A wallet identifier
Constructors
| Wallet | |
Fields | |
Instances
toMockWallet :: MockWallet -> Wallet Source #
knownWallets :: [Wallet] Source #
knownWallet :: Integer -> Wallet Source #
Constructors
| WalletId | |
Fields | |
Instances
walletToMockWallet :: Wallet -> Maybe MockWallet Source #
The MockWallet whose ID is the given wallet ID (if it exists)
walletToMockWallet' :: Wallet -> MockWallet Source #
The same as walletToMockWallet but fails with an error instead of returning Nothing.
mockWalletPaymentPubKey :: Wallet -> PaymentPubKey Source #
The public key of a mock wallet. (Fails if the wallet is not a mock wallet).
mockWalletPaymentPubKeyHash :: Wallet -> PaymentPubKeyHash Source #
The payment public key hash of a mock wallet. (Fails if the wallet is not a mock wallet).
mockWalletAddress :: Wallet -> CardanoAddress Source #
Get the cardano address of a mock wallet. (Fails if the wallet is not a mock wallet).
data WalletEvent Source #
Constructors
| GenericLog Text | |
| CheckpointLog CheckpointLogMsg | |
| RequestHandlerLog RequestHandlerLogMsg | |
| TxBalanceLog TxBalanceMsg |
Instances
data WalletState Source #
The state used by the mock wallet environment.
Constructors
| WalletState | |
Fields
| |
Instances
| Show WalletState Source # | |
Defined in Wallet.Emulator.Wallet | |
ownAddress :: WalletState -> CardanoAddress Source #
Get the user's own payment public-key address.
fromMockWallet :: MockWallet -> WalletState Source #
An empty wallet using the given private key. for that wallet as the sole watched address.
handleWallet :: (Member (Error WalletAPIError) effs, Member NodeClientEffect effs, Member ChainIndexQueryEffect effs, Member (State WalletState) effs, Member (LogMsg TxBalanceMsg) effs) => WalletEffect ~> Eff effs Source #
handleBalance :: (Member NodeClientEffect effs, Member ChainIndexQueryEffect effs, Member (State WalletState) effs, Member (LogMsg TxBalanceMsg) effs, Member (Error WalletAPIError) effs) => UnbalancedTx -> Eff effs CardanoTx Source #
handleAddSignature :: (Member (State WalletState) effs, Member (Error WalletAPIError) effs) => CardanoTx -> Eff effs CardanoTx Source #
ownOutputs :: forall effs. Member ChainIndexQueryEffect effs => WalletState -> Eff effs (Map TxOutRef DecoratedTxOut) Source #
defaultSigningProcess :: MockWallet -> SigningProcess Source #
The default signing process is signWallet
signWallet :: MockWallet -> SigningProcess Source #
Sign the transaction by calling signTxnWithKey (throwing a
PrivateKeyNotFound error if called with a key other than the
wallet's private key)
signTxnWithKey :: Member (Error WalletAPIError) r => MockWallet -> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx Source #
Sign the transaction with the private key of the mock wallet.
signTxWithPrivateKey :: Member (Error WalletAPIError) r => PaymentPrivateKey -> CardanoTx -> PaymentPubKeyHash -> Eff r CardanoTx Source #
Sign the transaction with the private key, if the hash is that of the private key.
signPrivateKeys :: [PaymentPrivateKey] -> SigningProcess Source #
Sign the transaction with the given private keys,
ignoring the list of public keys that the SigningProcess is passed.
data SigningProcessControlEffect r where Source #
Constructors
| SetSigningProcess :: Maybe SigningProcess -> SigningProcessControlEffect () |
setSigningProcess :: forall effs. Member SigningProcessControlEffect effs => Maybe SigningProcess -> Eff effs () Source #
type SigningProcessEffs = '[State (Maybe SigningProcess), Error WalletAPIError] Source #
handleSigningProcessControl :: Members SigningProcessEffs effs => Eff (SigningProcessControlEffect ': effs) ~> Eff effs Source #
An Entity is a thing that can hold Value. Used in the balances
function to compute who holds for a given chain state and set of wallets.
Instances
| Eq Entity Source # | |
| Ord Entity Source # | |
| Show Entity Source # | |
walletPaymentPubKeyHashes :: WalletSet -> Map PaymentPubKeyHash Wallet Source #
Pick out all the public keys from the set of wallets and map them back to their corresponding wallets.
balances :: ChainState -> WalletSet -> Map Entity Value Source #
For a set of wallets, convert them into a map of value: entity,
where entity is one of Entity.
Orphan instances
| Data WalletId Source # | |
Methods gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> WalletId -> c WalletId Source # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c WalletId Source # toConstr :: WalletId -> Constr Source # dataTypeOf :: WalletId -> DataType Source # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c WalletId) Source # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WalletId) Source # gmapT :: (forall b. Data b => b -> b) -> WalletId -> WalletId Source # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> WalletId -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> WalletId -> r Source # gmapQ :: (forall d. Data d => d -> u) -> WalletId -> [u] Source # gmapQi :: Int -> (forall d. Data d => d -> u) -> WalletId -> u Source # gmapM :: Monad m => (forall d. Data d => d -> m d) -> WalletId -> m WalletId Source # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> WalletId -> m WalletId Source # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> WalletId -> m WalletId Source # | |
| ToSchema WalletId Source # | |
Methods declareNamedSchema :: Proxy WalletId -> Declare (Definitions Schema) NamedSchema Source # | |