Skip to content
This repository has been archived by the owner on Dec 2, 2024. It is now read-only.

Commit

Permalink
Update SlotConfig in UnbalancedTx in local wallet client #285 (#304)
Browse files Browse the repository at this point in the history
  • Loading branch information
Evgenii Akentev authored Feb 8, 2022
1 parent b84f9a5 commit 869e698
Show file tree
Hide file tree
Showing 2 changed files with 15 additions and 6 deletions.
19 changes: 13 additions & 6 deletions plutus-pab/src/Cardano/Wallet/LocalClient.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,7 @@ import Cardano.Wallet.Primitive.Types.TokenMap qualified as C
import Cardano.Wallet.Primitive.Types.TokenPolicy qualified as C
import Cardano.Wallet.Primitive.Types.TokenQuantity qualified as C
import Cardano.Wallet.Primitive.Types.Tx qualified as C
import Control.Lens ((&), (.~), (^.))
import Control.Monad.Freer (Eff, LastMember, Member, sendM, type (~>))
import Control.Monad.Freer.Error (Error, throwError)
import Control.Monad.Freer.Extras.Log (LogMsg, logWarn)
Expand All @@ -39,10 +40,11 @@ import Data.Quantity (Quantity (Quantity))
import Data.Text (pack)
import Data.Text.Class (fromText)
import Ledger (CardanoTx)
import Ledger qualified
import Ledger.Ada qualified as Ada
import Ledger.Address (PaymentPubKeyHash (PaymentPubKeyHash))
import Ledger.Constraints.OffChain (UnbalancedTx)
import Ledger.Crypto (PubKeyHash (PubKeyHash))
import Ledger.Constraints.OffChain qualified as U
import Ledger.TimeSlot (posixTimeRangeToContainedSlotRange)
import Ledger.Tx.CardanoAPI (SomeCardanoApiTx (SomeTx), ToCardanoError, toCardanoTxBody)
import Ledger.Value (CurrencySymbol (CurrencySymbol), TokenName (TokenName), Value (Value))
import Plutus.Contract.Wallet (export)
Expand All @@ -52,17 +54,19 @@ import PlutusTx.Builtins.Internal (BuiltinByteString (BuiltinByteString))
import Prettyprinter (Pretty (pretty))
import Servant ((:<|>) ((:<|>)), (:>))
import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM)
import Wallet.API qualified as WAPI
import Wallet.Effects (WalletEffect (BalanceTx, OwnPaymentPubKeyHash, SubmitTxn, TotalFunds, WalletAddSignature, YieldUnbalancedTx))
import Wallet.Emulator.Error (WalletAPIError (OtherError, ToCardanoError))
import Wallet.Emulator.Wallet (Wallet (Wallet), WalletId (WalletId))

getWalletKey :: C.ApiT C.WalletId -> C.ApiT C.Role -> C.ApiT C.DerivationIndex -> Maybe Bool -> ClientM ApiVerificationKeyShelley
getWalletKey :: C.ApiT C.WalletId -> C.ApiT C.Role -> C.ApiT C.DerivationIndex -> Maybe Bool -> ClientM C.ApiVerificationKeyShelley
getWalletKey :<|> _ :<|> _ :<|> _ = client (Proxy @("v2" :> C.WalletKeys))

handleWalletClient
:: forall m effs.
( LastMember m effs
, MonadIO m
, Member WAPI.NodeClientEffect effs
, Member (Error ClientError) effs
, Member (Error WalletAPIError) effs
, Member (Reader ClientEnv) effs
Expand Down Expand Up @@ -101,16 +105,19 @@ handleWalletClient config (Wallet (WalletId walletId)) event = do
sealedTx <- either (throwError . ToCardanoError) pure $ toSealedTx protocolParams networkId tx
void . runClient $ C.postExternalTransaction C.transactionClient (C.ApiBytesT (C.SerialisedTx $ C.serialisedTx sealedTx))

ownPaymentPubKeyHashH :: Eff effs PaymentPubKeyHash
ownPaymentPubKeyHashH :: Eff effs Ledger.PaymentPubKeyHash
ownPaymentPubKeyHashH =
fmap (PaymentPubKeyHash . PubKeyHash . BuiltinByteString . fst . getApiVerificationKey) . runClient $
fmap (Ledger.PaymentPubKeyHash . Ledger.PubKeyHash . BuiltinByteString . fst . getApiVerificationKey) . runClient $
getWalletKey (C.ApiT walletId)
(C.ApiT C.UtxoExternal)
(C.ApiT (C.DerivationIndex 0))
(Just True)

balanceTxH :: UnbalancedTx -> Eff effs (Either WalletAPIError CardanoTx)
balanceTxH utx = do
balanceTxH utx' = do
slotConfig <- WAPI.getClientSlotConfig
let validitySlotRange = posixTimeRangeToContainedSlotRange slotConfig (utx' ^. U.validityTimeRange)
let utx = utx' & U.tx . Ledger.validRange .~ validitySlotRange
case export protocolParams networkId utx of
Left err -> do
logWarn $ BalanceTxError $ show $ pretty err
Expand Down
2 changes: 2 additions & 0 deletions plutus-pab/src/Plutus/PAB/App.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,6 +84,7 @@ import Plutus.PAB.Types (Config (Config), DbConfig (DbConfig, dbConfigFile),
WebserverConfig (WebserverConfig), chainIndexConfig, dbConfig, developmentOptions,
endpointTimeout, nodeServerConfig, pabWebserverConfig, walletServerConfig)
import Servant.Client (ClientEnv, ClientError, mkClientEnv)
import Wallet.API (NodeClientEffect)
import Wallet.Effects (WalletEffect)
import Wallet.Emulator.Wallet (Wallet)
import Wallet.Error (WalletAPIError)
Expand Down Expand Up @@ -197,6 +198,7 @@ appEffectHandlers storageBackend config trace BuiltinHandler{contractHandler} =
handleWalletEffect
:: forall effs.
( LastMember IO effs
, Member NodeClientEffect effs
, Member (Error ClientError) effs
, Member (Error WalletAPIError) effs
, Member (Error PABError) effs
Expand Down

0 comments on commit 869e698

Please sign in to comment.