diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Server.hs index 4a356d9fd5c..eb84cd3b56b 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Server.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Server.hs @@ -43,11 +43,9 @@ import Cardano.Wallet , networkLayer , normalizeDelegationAddress , normalizeSharedAddress - , utxoAssumptionsForWallet ) import Cardano.Wallet.Address.Derivation - ( Role (..) - , delegationAddressS + ( delegationAddressS , paymentAddressS ) import Cardano.Wallet.Address.Derivation.Icarus @@ -56,9 +54,6 @@ import Cardano.Wallet.Address.Derivation.Icarus import Cardano.Wallet.Address.Derivation.Shared ( SharedKey (..) ) -import Cardano.Wallet.Address.Derivation.SharedKey - ( constructAddressFromIx - ) import Cardano.Wallet.Address.Derivation.Shelley ( ShelleyKey (..) ) @@ -209,9 +204,6 @@ import Cardano.Wallet.Api.Types.SchemaMetadata ( TxMetadataSchema (..) , parseSimpleMetadataFlag ) -import Cardano.Wallet.Flavor - ( WalletFlavorS (..) - ) import Cardano.Wallet.Pools ( StakePoolLayer (..) ) @@ -377,7 +369,6 @@ server byron icarus shelley multisig spl ntp blockchainSource = shelleyTransactions :: Server (ShelleyTransactions n) shelleyTransactions = constructTransaction shelley - (delegationAddressS @n) (knownPools spl) (getPoolLifeCycleStatus spl) :<|> signTransaction shelley @@ -394,11 +385,7 @@ server byron icarus shelley multisig spl ntp blockchainSource = :<|> deleteTransaction shelley :<|> postTransactionOld shelley (delegationAddressS @n) :<|> postTransactionFeeOld shelley - :<|> balanceTransaction - shelley - (delegationAddressS @n) - (utxoAssumptionsForWallet ShelleyWallet) - mempty + :<|> balanceTransaction shelley :<|> decodeTransaction shelley :<|> submitTransaction @_ @_ @_ @n shelley @@ -653,7 +640,7 @@ server byron icarus shelley multisig spl ntp blockchainSource = :: ApiLayer (SharedState n SharedKey) -> Server (SharedTransactions n) sharedTransactions apilayer = - constructSharedTransaction apilayer (constructAddressFromIx @n UtxoInternal) + constructSharedTransaction apilayer (knownPools spl) (getPoolLifeCycleStatus spl) :<|> signTransaction apilayer :<|> decodeSharedTransaction apilayer diff --git a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs index d2554c37a64..b3bdf8840f7 100644 --- a/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/api/src/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -211,7 +211,6 @@ import Cardano.Wallet , readPrivateKey , readWalletMeta , txWitnessTagForKey - , utxoAssumptionsForWallet ) import Cardano.Wallet.Address.Book ( AddressBookIso @@ -505,16 +504,21 @@ import Cardano.Wallet.DB , DBLayer ) import Cardano.Wallet.Flavor - ( CredFromOf + ( AllFlavors + , CredFromOf , Excluding + , FlavorOf + , Including , KeyFlavorS (..) , KeyOf , NetworkOf - , WalletFlavor (..) + , WalletFlavor , WalletFlavorS (..) + , WalletFlavors (..) , keyFlavorFromState , keyOfWallet , shelleyOrShared + , walletFlavor ) import Cardano.Wallet.Network ( ErrFetchBlock (..) @@ -628,7 +632,6 @@ import Cardano.Wallet.Primitive.Types.Tx , UnsignedTx (..) , cardanoTxInExactEra , getSealedTxWitnesses - , sealedTxFromCardanoBody ) import Cardano.Wallet.Primitive.Types.Tx.Constraints ( txMintBurnMaxTokenQuantity @@ -829,8 +832,8 @@ import Internal.Cardano.Write.Tx ( AnyRecentEra (..) ) import Internal.Cardano.Write.Tx.Balance - ( Redeemer (..) - , UTxOAssumptions (..) + ( PartialTx (..) + , Redeemer (..) ) import Internal.Cardano.Write.Tx.Sign ( TimelockKeyWitnessCounts @@ -952,8 +955,10 @@ import qualified Internal.Cardano.Write.Tx as Write , IsRecentEra , PParamsInAnyRecentEra (PParamsInAnyRecentEra) , RecentEra + , Tx , TxIn , TxOutInRecentEra (TxOutInRecentEra) + , cardanoEra , cardanoEraFromRecentEra , fromCardanoApiTx , getFeePerByte @@ -963,9 +968,6 @@ import qualified Internal.Cardano.Write.Tx as Write ) import qualified Internal.Cardano.Write.Tx.Balance as Write ( PartialTx (PartialTx) - , balanceTx - , constructUTxOIndex - , fromWalletUTxO ) import qualified Internal.Cardano.Write.Tx.Sign as Write ( TimelockKeyWitnessCounts (TimelockKeyWitnessCounts) @@ -2709,13 +2711,12 @@ constructTransaction :: forall s n . (HasSNetworkId n, s ~ SeqState n ShelleyKey) => ApiLayer s - -> ArgGenChange s -> IO (Set PoolId) -> (PoolId -> IO PoolLifeCycleStatus) -> ApiT WalletId -> ApiConstructTransactionData n -> Handler (ApiConstructTransaction n) -constructTransaction api argGenChange knownPools poolStatus apiWalletId body = do +constructTransaction api knownPools poolStatus apiWalletId body = do body & \(ApiConstructTransactionData _ _ _ _ _ _ _ _ _ _) -> -- Above is the way to get a compiler error when number of fields changes, -- in order not to forget to update the pattern below: @@ -2756,7 +2757,7 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d let db = wrk ^. dbLayer netLayer = wrk ^. networkLayer - (Write.PParamsInAnyRecentEra era pp, _) + (Write.PParamsInAnyRecentEra era pp, timeTranslation) <- liftIO $ W.readNodeTipStateForTxWrite netLayer when (isJust (body ^. #vote)) $ @@ -2916,18 +2917,16 @@ constructTransaction api argGenChange knownPools poolStatus apiWalletId body = d $ maybe [] NE.toList mintBurnDatum balancedTx <- - balanceTransaction - api - argGenChange - (utxoAssumptionsForWallet (walletFlavor @s)) - mintBurnTimelockKeyWitCounts - apiWalletId - ApiBalanceTransactionPostData - { transaction = ApiT - $ sealedTxFromCardanoBody unbalancedTx - , inputs = [] - , redeemers = [] - , encoding = body ^. #encoding + fmap (toApiSerialisedTransaction (body ^. #encoding)) + . liftIO $ W.balanceTx + wrk + pp + timeTranslation + PartialTx + { tx = Write.fromCardanoApiTx $ Cardano.Tx unbalancedTx [] + , extraUTxO = mempty + , redeemers = mempty + , timelockKeyWitnessCounts = mintBurnTimelockKeyWitCounts } apiDecoded <- decodeTransaction @_ @n api apiWalletId @@ -3263,14 +3262,13 @@ parseValidityInterval ti validityInterval = do constructSharedTransaction :: forall n . HasSNetworkId n => ApiLayer (SharedState n SharedKey) - -> ArgGenChange (SharedState n SharedKey) -> IO (Set PoolId) -> (PoolId -> IO PoolLifeCycleStatus) -> ApiT WalletId -> ApiConstructTransactionData n -> Handler (ApiConstructTransaction n) constructSharedTransaction - api argGenChange knownPools getPoolStatus (ApiT wid) body = do + api knownPools getPoolStatus (ApiT wid) body = do let isNoPayload = isNothing (body ^. #payments) && isNothing (body ^. #withdrawal) && @@ -3293,7 +3291,7 @@ constructSharedTransaction netLayer = wrk ^. networkLayer currentEpochSlotting <- liftIO $ getCurrentEpochSlotting netLayer - (Write.PParamsInAnyRecentEra era pp, _) + (Write.PParamsInAnyRecentEra era pp, timeTranslation) <- liftIO $ W.readNodeTipStateForTxWrite netLayer (cp, _, _) <- handler $ W.readWallet wrk @@ -3339,28 +3337,27 @@ constructSharedTransaction [] Just (ApiPaymentAddresses content) -> F.toList (addressAmountToTxOut <$> content) - (unbalancedTx, scriptLookup) <- liftHandler $ + unbalancedTx <- liftHandler $ W.constructUnbalancedSharedTransaction @n era db txCtx PreSelection {outputs = outs} - balancedTx <- - balanceTransaction api argGenChange - (AllScriptPaymentCredentialsFrom - (Shared.paymentTemplate (getState cp)) - (scriptLookup . Convert.toWalletAddress) - ) - mempty - (ApiT wid) - ApiBalanceTransactionPostData - { transaction = - ApiT $ sealedTxFromCardanoBody unbalancedTx - , inputs = [] - , redeemers = [] - , encoding = body ^. #encoding + balancedTx <- liftIO $ W.balanceTx + wrk + pp + timeTranslation + PartialTx + { tx = Write.fromCardanoApiTx + $ Cardano.Tx unbalancedTx [] + , extraUTxO = mempty + , redeemers = mempty + , timelockKeyWitnessCounts = mempty } - apiDecoded <- decodeSharedTransaction api (ApiT wid) - (toApiDecodeTransactionPostData balancedTx) + apiDecoded <- decodeSharedTransaction api (ApiT wid) $ + ApiDecodeTransactionPostData + { transaction = ApiT (sealWriteTx balancedTx) + , decrypt_metadata = Nothing + } let deposits = case optionalDelegationAction of Just (JoinRegisteringKey _poolId) -> [W.getStakeKeyDeposit pp] @@ -3384,7 +3381,9 @@ constructSharedTransaction pure Nothing pure $ ApiConstructTransaction - { transaction = balancedTx + { transaction = toApiSerialisedTransaction + (body ^. #encoding) + balancedTx , coinSelection = mkApiCoinSelection deposits refunds delCertsWithPath md @@ -3512,53 +3511,27 @@ decodeSharedTransaction ctx (ApiT wid) postData = do } balanceTransaction - :: forall s - . (GenChange s, WalletFlavor s) + :: forall s. + ( GenChange s + , WalletFlavor s + , Including AllFlavors '[ 'ShelleyF, 'SharedF] (FlavorOf s) + , HasSNetworkId (NetworkOf s) + ) => ApiLayer s - -> ArgGenChange s - -> UTxOAssumptions - -> TimelockKeyWitnessCounts -> ApiT WalletId -> ApiBalanceTransactionPostData (NetworkOf s) -> Handler ApiSerialisedTransaction -balanceTransaction - ctx@ApiLayer{..} - argGenChange - utxoAssumptions - timelockKeyWitnessCounts - (ApiT wid) - body - = do - (Write.PParamsInAnyRecentEra era pp, timeTranslation) - <- liftIO $ W.readNodeTipStateForTxWrite netLayer +balanceTransaction ctx (ApiT wid) body = do withWorkerCtx ctx wid liftE liftE $ \wrk -> do - (utxo, wallet, _txs) <- handler $ W.readWalletUTxO wrk - let utxoIndex = - Write.constructUTxOIndex $ - Write.fromWalletUTxO utxo + (Write.PParamsInAnyRecentEra era pp, timeTranslation) + <- liftIO $ W.readNodeTipStateForTxWrite (wrk ^. networkLayer) partialTx <- parsePartialTx era - balancedTx <- liftHandler - . fmap - ( Cardano.InAnyCardanoEra - (Write.cardanoEraFromRecentEra era) - . Write.toCardanoApiTx - . fst - ) - $ Write.balanceTx + balancedTx <- liftIO $ W.balanceTx + wrk pp timeTranslation - utxoAssumptions - utxoIndex - (W.defaultChangeAddressGen argGenChange) - (getState wallet) partialTx - - case body ^. #encoding of - Just HexEncoded -> - pure $ ApiSerialisedTransaction - (ApiT $ W.sealedTxFromCardano balancedTx) HexEncoded - _ -> pure $ ApiSerialisedTransaction - (ApiT $ W.sealedTxFromCardano balancedTx) Base64Encoded + return $ toApiSerialisedTransaction (body ^. #encoding) balancedTx where parsePartialTx :: Write.IsRecentEra era @@ -3585,7 +3558,7 @@ balanceTransaction (Write.fromCardanoApiTx tx) externalUTxO (fromApiRedeemer <$> body ^. #redeemers) - timelockKeyWitnessCounts + (mempty :: TimelockKeyWitnessCounts) Left e -> liftHandler $ throwE e decodeTransaction @@ -5116,6 +5089,22 @@ fromApiRedeemer = \case ApiRedeemerRewarding (ApiBytesT bytes) (StakeAddress x y) -> RedeemerRewarding bytes (RewardAcnt x y) +sealWriteTx :: forall era. Write.IsRecentEra era => Write.Tx era -> W.SealedTx +sealWriteTx = W.sealedTxFromCardano + . Cardano.InAnyCardanoEra (Write.cardanoEra @era) + . Write.toCardanoApiTx + +toApiSerialisedTransaction + :: Write.IsRecentEra era + => Maybe ApiSealedTxEncoding + -> Write.Tx era + -> ApiSerialisedTransaction +toApiSerialisedTransaction maybeEncoding tx = + let + encoding = fromMaybe Base64Encoded maybeEncoding + in + ApiSerialisedTransaction (ApiT $ sealWriteTx tx) encoding + {------------------------------------------------------------------------------- Api Layer -------------------------------------------------------------------------------} diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index b168b42b0e4..a9989832ecb 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -144,10 +144,9 @@ module Cardano.Wallet , readNodeTipStateForTxWrite , buildSignSubmitTransaction , buildTransaction - , buildTransactionPure - , buildAndSignTransactionPure , buildAndSignTransaction , BuiltTx (..) + , balanceTx , signTransaction , constructTransaction , constructTxMeta @@ -301,6 +300,7 @@ import Cardano.Wallet.Address.Derivation , Role (..) , SoftDerivation (..) , ToRewardAccount (..) + , delegationAddressS , deriveRewardAccount , liftDelegationAddressS , liftIndex @@ -318,6 +318,7 @@ import Cardano.Wallet.Address.Derivation.MintBurn ) import Cardano.Wallet.Address.Derivation.SharedKey ( SharedKey (..) + , constructAddressFromIx , replaceCosignersWithVerKeys ) import Cardano.Wallet.Address.Derivation.Shelley @@ -623,7 +624,6 @@ import Cardano.Wallet.Transaction.Built import Cardano.Write.Tx ( ErrBalanceTx (..) , ErrBalanceTxUnableToCreateChangeError (..) - , balanceTx ) import Control.Arrow ( (>>>) @@ -883,6 +883,7 @@ import qualified Internal.Cardano.Write.Tx as Write import qualified Internal.Cardano.Write.Tx.Balance as Write ( PartialTx , UTxOIndex + , balanceTx , constructUTxOIndex , fromWalletUTxO ) @@ -2149,6 +2150,71 @@ readNodeTipStateForTxWrite netLayer = do $ ErrNodeNotYetInRecentEra nopp Right pp -> pure (pp, timeTranslation) +-- | Wallet-specific wrapped version of 'Write.balanceTx', made for the new tx +-- workflow with Shelley- and Shared- wallet flavors. +-- +-- Changes to the change state are not written to the DB. +balanceTx + :: forall s era. + ( GenChange s + , WalletFlavor s + , HasSNetworkId (NetworkOf s) + , Write.IsRecentEra era + , Including AllFlavors '[ 'ShelleyF, 'SharedF] (FlavorOf s) + ) + => WalletLayer IO s + -> Write.PParams era + -> TimeTranslation + -> PartialTx era + -> IO (Write.Tx era) +balanceTx wrk pp timeTranslation partialTx = do + (utxo, wallet, _txs) <- liftIO $ readWalletUTxO wrk + -- FIXME: Why are we not using the availableUTxO here? + let utxoIndex = + Write.constructUTxOIndex $ + Write.fromWalletUTxO utxo + + let utxoAssumptions = case walletFlavor @s of + ShelleyWallet -> AllKeyPaymentCredentials + SharedWallet -> AllScriptPaymentCredentialsFrom + (Shared.paymentTemplate (getState wallet)) + (sharedWalletScriptLookup (getState wallet) + . Convert.toWalletAddress) + + let changeState = getState wallet + (tx, _changeState') <- throwBalanceTxErr $ Write.balanceTx + pp + timeTranslation + utxoAssumptions + utxoIndex + (defaultChangeAddressGen argGenChange) + changeState + partialTx + + return tx + where + argGenChange :: ArgGenChange s + argGenChange = case walletFlavor @s of + ShelleyWallet -> delegationAddressS @(NetworkOf s) + SharedWallet -> constructAddressFromIx @(NetworkOf s) UtxoInternal + + sharedWalletScriptLookup + :: SharedState (NetworkOf s) SharedKey -> Address -> CA.Script KeyHash + sharedWalletScriptLookup s addr = case fst (isShared addr s) of + Nothing -> + error $ "Some inputs selected by coin selection do not belong " + <> "to multi-signature wallet" + Just (ix,role) -> + let template = paymentTemplate s + role' = case role of + UtxoExternal -> CAShelley.UTxOExternal + UtxoInternal -> CAShelley.UTxOInternal + MutableAccount -> + error "role is specified only for payment credential" + in replaceCosignersWithVerKeys role' template ix + + throwBalanceTxErr = throwWrappedErr ExceptionBalanceTx + -- | Build, Sign, Submit transaction. -- -- Requires the encryption passphrase in order to decrypt the root private key. @@ -2236,11 +2302,6 @@ buildSignSubmitTransaction db@DBLayer{..} netLayer txLayer & fmap (BuiltTx{..},) & liftIO where - throwOnErr :: (MonadIO m, Exception e) => Either e a -> m a - throwOnErr = either (liftIO . throwIO) pure - - throwWrappedErr f e = runExceptT (withExceptT f e) >>= throwOnErr - wrapRootKeyError = ExceptionWitnessTx . ErrWitnessTxWithRootKey wrapNetworkError = ExceptionSubmitTx . ErrSubmitTxNetwork @@ -2433,7 +2494,7 @@ buildTransactionPure Write.constructUTxOIndex $ Write.fromWalletUTxO utxo withExceptT Left $ - balanceTx @_ @_ @s + Write.balanceTx @_ @_ @s pparams timeTranslation (utxoAssumptionsForWallet (walletFlavor @s)) @@ -2562,34 +2623,18 @@ constructUnbalancedSharedTransaction -> DBLayer IO (SharedState n SharedKey) -> TransactionCtx -> PreSelection - -> ExceptT ErrConstructTx IO - ( Cardano.TxBody (Write.CardanoApiEra era) - , (Address -> CA.Script KeyHash) - ) + -> ExceptT ErrConstructTx IO (Cardano.TxBody (Write.CardanoApiEra era)) constructUnbalancedSharedTransaction era db txCtx sel = db & \DBLayer{..} -> do cp <- lift $ atomically readCheckpoint let s = getState cp scriptM = flip (replaceCosignersWithVerKeys CAShelley.Stake) minBound <$> delegationTemplate s - getScript addr = case fst (isShared addr s) of - Nothing -> - error $ "Some inputs selected by coin selection do not belong " - <> "to multi-signature wallet" - Just (ix,role) -> - let template = paymentTemplate s - role' = case role of - UtxoExternal -> CAShelley.UTxOExternal - UtxoInternal -> CAShelley.UTxOInternal - MutableAccount -> - error "role is specified only for payment credential" - in replaceCosignersWithVerKeys role' template ix when (containsWithdrawal (txCtx ^. #txWithdrawal)) $ assertIsVoting db era - sealedTx <- mapExceptT atomically $ do + mapExceptT atomically $ do withExceptT ErrConstructTxBody $ ExceptT $ pure $ mkUnsignedTransaction netId (Right scriptM) txCtx (Left sel) - pure (sealedTx, getScript) where netId = networkIdVal $ sNetworkId @n @@ -3159,7 +3204,7 @@ transactionFee DBLayer{atomically, walletState} protocolParams wrapErrBalanceTx $ calculateFeePercentiles $ do res <- runExceptT $ - balanceTx @_ @_ @s + Write.balanceTx @_ @_ @s protocolParams timeTranslation (utxoAssumptionsForWallet (walletFlavor @s)) @@ -3183,13 +3228,6 @@ transactionFee DBLayer{atomically, walletState} protocolParams . ExceptT . pure - throwWrappedErr - :: (Exception e, MonadIO m) - => (e' -> e) - -> ExceptT e' m a -> - m a - throwWrappedErr f a = either (throwIO . f) pure =<< runExceptT a - -- | Repeatedly (100 times) runs given transaction fee estimation calculation -- returning 1st and 9nth decile (10nth and 90nth percentile) values of a -- recoded distribution. @@ -3854,6 +3892,13 @@ data PoolRetirementEpochInfo = PoolRetirementEpochInfo } deriving (Eq, Generic, Show) +throwOnErr :: (MonadIO m, Exception e) => Either e a -> m a +throwOnErr = either (liftIO . throwIO) pure + +throwWrappedErr + :: (MonadIO m, Exception e1) => (e2 -> e1) -> ExceptT e2 m b -> m b +throwWrappedErr f e = runExceptT (withExceptT f e) >>= throwOnErr + {------------------------------------------------------------------------------- Logging -------------------------------------------------------------------------------}