diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs index 718026af786..0cbeaa14de7 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs @@ -715,17 +715,21 @@ instance IsServerError ErrFetchRewards where instance IsServerError ErrReadRewardAccount where toServerError = \case ErrReadRewardAccountNotAShelleyWallet -> - apiError err403 InvalidWalletType $ mconcat - [ "It is regrettable but you've just attempted an operation " - , "that is invalid for this type of wallet. Only new 'Shelley' " - , "wallets can do something with rewards and this one isn't." - ] + apiError err403 InvalidWalletType $ mconcat errMsg + ErrReadRewardAccountNotASharedWallet -> + apiError err403 InvalidWalletType $ mconcat errMsg ErrReadRewardAccountMissing -> apiError err501 MissingRewardAccount $ mconcat [ "I couldn't read a reward account which is required for " , "withdrawals. Either there is db malfunction or withdrawals " , "was used for shared wallets missing delegation template." ] + where + errMsg = + [ "It is regrettable but you've just attempted an operation " + , "that is invalid for this type of wallet. Only new 'Shelley' and " + , "'Shared' wallets can do something with rewards and this one isn't." + ] instance IsServerError ErrReadPolicyPublicKey where toServerError = \case diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs index a0ca5143dd4..de764d487c1 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -4447,7 +4447,7 @@ mkApiTransaction timeInterpreter wrk timeRefLens tx = do parsedValues <- traverse parseTxCBOR $ tx ^. #txCBOR parsedCertificates <- if hasDelegation (Proxy @s) - then traverse (getApiAnyCertificates db) parsedValues + then traverse (getApiAnyCertificates db (keyFlavorFromState @s)) parsedValues else pure Nothing parsedMintBurn <- forM parsedValues $ getTxApiAssetMintBurn @_ @s wrk @@ -4498,10 +4498,20 @@ mkApiTransaction timeInterpreter wrk timeRefLens tx = do -- | Promote certificates of a transaction to API type, -- using additional context from the 'WorkerCtx'. - getApiAnyCertificates db ParsedTxCBOR{certificates} = do - (rewardAccount, _, derivPath) <- liftHandler - $ W.shelleyOnlyReadRewardAccount @s db - pure $ mkApiAnyCertificate (Just rewardAccount) derivPath <$> certificates + getApiAnyCertificates db flavor ParsedTxCBOR{certificates} = case flavor of + ShelleyKeyS -> do + (rewardAcct, _, path) <- liftHandler + $ W.shelleyOnlyReadRewardAccount @s db + pure $ mkApiAnyCertificate (Just rewardAcct) path <$> certificates + SharedKeyS -> do + infoM <- liftHandler + $ W.sharedOnlyReadRewardAccount @s db + case infoM of + Just (rewardAcct, path) -> + pure $ mkApiAnyCertificate (Just rewardAcct) path <$> certificates + _ -> pure [] + _ -> + pure [] depositIfAny :: Natural depositIfAny diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index f0cd2b2a37b..0be1c8faa24 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -91,6 +91,7 @@ module Cardano.Wallet , mkSelfWithdrawal , mkSelfWithdrawalShared , shelleyOnlyMkSelfWithdrawal + , sharedOnlyReadRewardAccount , readRewardAccount , shelleyOnlyReadRewardAccount , someRewardAccount @@ -586,8 +587,6 @@ import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Maybe ( fromJust, fromMaybe, isJust, isNothing, mapMaybe, maybeToList ) -import Data.Proxy - ( Proxy (..) ) import Data.Quantity ( Quantity (..) ) import Data.Set @@ -1320,10 +1319,6 @@ readRewardAccount db = do let xpub = Seq.rewardAccountKey walletState let path = stakeDerivationPath $ Seq.derivationPrefix walletState pure (toRewardAccount xpub, getRawKey ShelleyKeyS xpub, path) - where - readWalletCheckpoint - :: DBLayer IO s -> IO (Wallet s) - readWalletCheckpoint DBLayer{..} = liftIO $ atomically readCheckpoint readSharedRewardAccount :: forall n @@ -1335,10 +1330,26 @@ readSharedRewardAccount db = do case Shared.rewardAccountKey walletState of Just rewardAcct -> pure $ Just (rewardAcct, path) Nothing -> pure Nothing - where - readWalletCheckpoint - :: DBLayer IO s -> IO (Wallet s) - readWalletCheckpoint DBLayer{..} = liftIO $ atomically readCheckpoint + +readWalletCheckpoint + :: DBLayer IO s -> IO (Wallet s) +readWalletCheckpoint DBLayer{..} = liftIO $ atomically readCheckpoint + +sharedOnlyReadRewardAccount + :: forall s + . WalletFlavor s + => DBLayer IO s + -> ExceptT ErrReadRewardAccount IO + (Maybe (RewardAccount, NonEmpty DerivationIndex)) +sharedOnlyReadRewardAccount db = do + case walletFlavor @s of + SharedWallet -> do + walletState <- lift $ getState <$> readWalletCheckpoint db + let path = stakeDerivationPath $ Shared.derivationPrefix walletState + case Shared.rewardAccountKey walletState of + Just rewardAcct -> pure $ Just (rewardAcct, path) + Nothing -> pure Nothing + _ -> throwE ErrReadRewardAccountNotASharedWallet -- | Unsafe version of the `readRewardAccount` function -- that throws error when applied to a non-sequential @@ -3470,6 +3481,7 @@ data ErrNotASequentialWallet data ErrReadRewardAccount = ErrReadRewardAccountNotAShelleyWallet + | ErrReadRewardAccountNotASharedWallet | ErrReadRewardAccountMissing deriving (Generic, Eq, Show) diff --git a/lib/wallet/src/Cardano/Wallet/Address/HasDelegation.hs b/lib/wallet/src/Cardano/Wallet/Address/HasDelegation.hs index 7d6da0263cf..2590992b577 100644 --- a/lib/wallet/src/Cardano/Wallet/Address/HasDelegation.hs +++ b/lib/wallet/src/Cardano/Wallet/Address/HasDelegation.hs @@ -39,4 +39,4 @@ instance HasDelegation (SeqState n IcarusKey) where hasDelegation _ = False instance HasDelegation (SharedState n SharedKey) where - hasDelegation _ = False + hasDelegation _ = True