diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs index 667cafe22b0..1a9e4488818 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shared/Transactions.hs @@ -24,21 +24,34 @@ import Cardano.Mnemonic import Cardano.Wallet.Api.Types ( ApiAddress , ApiConstructTransaction (..) + , ApiDecodedTransaction (..) , ApiFee (..) + , ApiSerialisedTransaction (..) , ApiSharedWallet (..) + , ApiT (..) , ApiTransaction + , ApiTxInputGeneral (..) + , ApiTxMetadata (..) + , ApiTxOutputGeneral (..) , ApiWallet + , ApiWalletOutput (..) , DecodeAddress , DecodeStakeAddress , EncodeAddress (..) , WalletStyle (..) ) +import Cardano.Wallet.Primitive.AddressDerivation + ( DerivationIndex (..) ) import Cardano.Wallet.Primitive.Passphrase ( Passphrase (..) ) +import Cardano.Wallet.Primitive.Types.Tx + ( TxMetadata (..), TxMetadataValue (..), TxScriptValidity (..) ) import Control.Monad.IO.Unlift ( MonadUnliftIO (..), liftIO ) import Control.Monad.Trans.Resource ( runResourceT ) +import Data.Aeson + ( toJSON ) import Data.Either.Combinators ( swapEither ) import Data.Generics.Internal.VL.Lens @@ -52,7 +65,7 @@ import Numeric.Natural import Test.Hspec ( SpecWith, describe ) import Test.Hspec.Expectations.Lifted - ( shouldBe, shouldSatisfy ) + ( shouldBe, shouldNotContain, shouldSatisfy ) import Test.Hspec.Extra ( it ) import Test.Integration.Framework.DSL @@ -91,7 +104,10 @@ import Test.Integration.Framework.TestData ) import qualified Cardano.Wallet.Api.Link as Link +import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap import qualified Data.ByteArray as BA +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map import qualified Data.Text.Encoding as T import qualified Network.HTTP.Types as HTTP @@ -134,7 +150,8 @@ spec = describe "SHARED_TRANSACTIONS" $ do [ expectResponseCode HTTP.status201 ] - let (ApiSharedWallet (Left wal)) = getFromResponse id rPost + let (ApiSharedWallet (Left wal)) = + getFromResponse Prelude.id rPost let metadata = Json [json|{ "metadata": { "1": { "string": "hello" } } }|] @@ -173,7 +190,8 @@ spec = describe "SHARED_TRANSACTIONS" $ do [ expectResponseCode HTTP.status201 ] - let walShared@(ApiSharedWallet (Right wal)) = getFromResponse id rPost + let walShared@(ApiSharedWallet (Right wal)) = + getFromResponse Prelude.id rPost let metadata = Json [json|{ "metadata": { "1": { "string": "hello" } } }|] @@ -195,6 +213,22 @@ spec = describe "SHARED_TRANSACTIONS" $ do , expectField (#fee . #getQuantity) (`shouldSatisfy` (>0)) ] + let txCbor = getFromResponse #transaction rTx2 + let decodePayload = Json (toJSON $ ApiSerialisedTransaction txCbor) + rDecodedTx <- request @(ApiDecodedTransaction n) ctx + (Link.decodeTransaction @'Shared wal) Default decodePayload + let expectedFee = getFromResponse (#fee . #getQuantity) rTx2 + let metadata' = ApiT (TxMetadata (Map.fromList [(1,TxMetaText "hello")])) + verify rDecodedTx + [ expectResponseCode HTTP.status202 + , expectField (#fee . #getQuantity) (`shouldBe` expectedFee) + , expectField #withdrawals (`shouldBe` []) + , expectField #collateral (`shouldBe` []) + , expectField #metadata + (`shouldBe` (ApiTxMetadata (Just metadata'))) + , expectField #scriptValidity (`shouldBe` (Just $ ApiT TxScriptValid)) + ] + it "SHARED_TRANSACTIONS_CREATE_01a - Empty payload is not allowed" $ \ctx -> runResourceT $ do wa <- fixtureSharedWallet ctx let emptyPayload = Json [json|{}|] @@ -249,6 +283,55 @@ spec = describe "SHARED_TRANSACTIONS" $ do , expectField (#coinSelection . #change) (`shouldSatisfy` (not . null)) , expectField (#fee . #getQuantity) (`shouldSatisfy` (> 0)) ] + let txCbor = getFromResponse #transaction rTx + let decodePayload = Json (toJSON $ ApiSerialisedTransaction txCbor) + rDecodedTxSource <- request @(ApiDecodedTransaction n) ctx + (Link.decodeTransaction @'Shared wa) Default decodePayload + rDecodedTxTarget <- request @(ApiDecodedTransaction n) ctx + (Link.decodeTransaction @'Shelley wb) Default decodePayload + + let expectedFee = getFromResponse (#fee . #getQuantity) rTx + let sharedExpectationsBetweenWallets = + [ expectResponseCode HTTP.status202 + , expectField (#fee . #getQuantity) (`shouldBe` expectedFee) + , expectField #withdrawals (`shouldBe` []) + , expectField #collateral (`shouldBe` []) + , expectField #metadata (`shouldBe` (ApiTxMetadata Nothing)) + , expectField #scriptValidity (`shouldBe` (Just $ ApiT TxScriptValid)) + ] + + verify rDecodedTxTarget sharedExpectationsBetweenWallets + + let isInpOurs inp = case inp of + ExternalInput _ -> False + WalletInput _ -> True + let areOurs = all isInpOurs + addrs <- listAddresses @n ctx wb + let addrIx = 1 + let addrDest = (addrs !! addrIx) ^. #id + let expectedTxOutTarget = WalletOutput $ ApiWalletOutput + { address = addrDest + , amount = Quantity amt + , assets = ApiT TokenMap.empty + , derivationPath = NE.fromList + [ ApiT (DerivationIndex 2147485500) + , ApiT (DerivationIndex 2147485463) + , ApiT (DerivationIndex 2147483648) + , ApiT (DerivationIndex 0) + , ApiT (DerivationIndex $ fromIntegral addrIx) + ] + } + let isOutOurs out = case out of + WalletOutput _ -> False + ExternalOutput _ -> True + + verify rDecodedTxSource $ + sharedExpectationsBetweenWallets ++ + [ expectField #inputs (`shouldSatisfy` areOurs) + , expectField #outputs (`shouldNotContain` [expectedTxOutTarget]) + -- Check that the change output is there: + , expectField (#outputs) ((`shouldBe` 1) . length . filter isOutOurs) + ] it "SHARED_TRANSACTIONS_CREATE_04b - Cannot spend less than minUTxOValue" $ \ctx -> runResourceT $ do wa <- fixtureSharedWallet ctx @@ -320,7 +403,7 @@ spec = describe "SHARED_TRANSACTIONS" $ do rAddr <- request @[ApiAddress n] ctx (Link.listAddresses @'Shared wal) Default Empty expectResponseCode HTTP.status200 rAddr - let sharedAddrs = getFromResponse id rAddr + let sharedAddrs = getFromResponse Prelude.id rAddr let destination = (sharedAddrs !! 1) ^. #id wShelley <- fixtureWallet ctx @@ -379,7 +462,8 @@ spec = describe "SHARED_TRANSACTIONS" $ do verify (fmap (swapEither . view #wallet) <$> rPost) [ expectResponseCode HTTP.status201 ] - let walShared@(ApiSharedWallet (Right wal)) = getFromResponse id rPost + let walShared@(ApiSharedWallet (Right wal)) = + getFromResponse Prelude.id rPost fundSharedWallet ctx faucetUtxoAmt walShared diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index bd2b2a9d07e..87dab76dcfe 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -149,6 +149,7 @@ module Cardano.Wallet.Api , SharedTransactions , ConstructSharedTransaction + , DecodeSharedTransaction , Proxy_ , PostExternalTransaction @@ -1112,6 +1113,7 @@ type ListSharedAddresses n = "shared-wallets" type SharedTransactions n = ConstructSharedTransaction n + :<|> DecodeSharedTransaction n -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/constructSharedTransaction type ConstructSharedTransaction n = "shared-wallets" @@ -1120,6 +1122,12 @@ type ConstructSharedTransaction n = "shared-wallets" :> ReqBody '[JSON] (ApiConstructTransactionDataT n) :> PostAccepted '[JSON] (ApiConstructTransactionT n) +-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/decodeSharedTransaction +type DecodeSharedTransaction n = "shared-wallets" + :> Capture "walletId" (ApiT WalletId) + :> "transactions-decode" + :> ReqBody '[JSON] ApiSerialisedTransaction + :> PostAccepted '[JSON] (ApiDecodedTransactionT n) {------------------------------------------------------------------------------- Proxy_ diff --git a/lib/core/src/Cardano/Wallet/Api/Link.hs b/lib/core/src/Cardano/Wallet/Api/Link.hs index b686dfbeb6d..2057b9594d0 100644 --- a/lib/core/src/Cardano/Wallet/Api/Link.hs +++ b/lib/core/src/Cardano/Wallet/Api/Link.hs @@ -755,7 +755,7 @@ decodeTransaction decodeTransaction w = discriminate @style (endpoint @(Api.DecodeTransaction Net) (wid &)) (notSupported "Byron") - (notSupported "Shared") + (endpoint @(Api.DecodeSharedTransaction Net) (wid &)) where wid = w ^. typed @(ApiT WalletId) diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 016245b1385..b693f8faaa9 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -97,6 +97,7 @@ module Cardano.Wallet.Api.Server , postPolicyKey , postPolicyId , constructSharedTransaction + , decodeSharedTransaction -- * Server error responses , IsServerError(..) @@ -2708,6 +2709,72 @@ constructSharedTransaction ctx genChange _knownPools _getPoolStatus (ApiT wid) b ti :: TimeInterpreter (ExceptT PastHorizonException IO) ti = timeInterpreter (ctx ^. networkLayer) +decodeSharedTransaction + :: forall ctx s k n. + ( ctx ~ ApiLayer s k + , IsOurs s Address + , HasNetworkLayer IO ctx + ) + => ctx + -> ApiT WalletId + -> ApiSerialisedTransaction + -> Handler (ApiDecodedTransaction n) +decodeSharedTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do + era <- liftIO $ NW.currentNodeEra nl + let (decodedTx, _toMint, _toBurn, _allCerts, interval) = + decodeTx tl era sealed + let (Tx { txId + , fee + , resolvedInputs + , resolvedCollateralInputs + , outputs + , metadata + , scriptValidity + }) = decodedTx + (txinsOutsPaths, collateralInsOutsPaths, outsPath) + <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do + inputPaths <- + liftHandler $ W.lookupTxIns @_ @s @k wrk wid $ + fst <$> resolvedInputs + collateralInputPaths <- + liftHandler $ W.lookupTxIns @_ @s @k wrk wid $ + fst <$> resolvedCollateralInputs + outputPaths <- + liftHandler $ W.lookupTxOuts @_ @s @k wrk wid outputs + pure + ( inputPaths + , collateralInputPaths + , outputPaths + ) + pure $ ApiDecodedTransaction + { id = ApiT txId + , fee = maybe (Quantity 0) (Quantity . fromIntegral . unCoin) fee + , inputs = map toInp txinsOutsPaths + , outputs = map toOut outsPath + , collateral = map toInp collateralInsOutsPaths + -- TODO: [ADP-1670] + , collateralOutputs = ApiAsArray Nothing + , withdrawals = [] + -- TODO minting/burning multisig + , mint = emptyApiAssetMntBurn + , burn = emptyApiAssetMntBurn + -- TODO delegation/withdrawals multisig + , certificates = [] + , depositsTaken = [] + , depositsReturned = [] + , metadata = ApiTxMetadata $ ApiT <$> metadata + , scriptValidity = ApiT <$> scriptValidity + , validityInterval = interval + } + where + tl = ctx ^. W.transactionLayer @k + nl = ctx ^. W.networkLayer @IO + + emptyApiAssetMntBurn = ApiAssetMintBurn + { tokens = [] + , walletPolicyKeyHash = Nothing + , walletPolicyKeyIndex = Nothing + } -- TODO: Most of the body of this function should really belong to -- Cardano.Wallet to keep the Api.Server module free of business logic! @@ -2889,28 +2956,6 @@ decodeTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do , walletPolicyKeyIndex = policyIx <$ includePolicyKeyInfo tokenWithScripts xpubM } - toOut (txoutIncoming, Nothing) = - ExternalOutput $ toAddressAmount @n txoutIncoming - toOut ((TxOut addr (TokenBundle (Coin c) tmap)), (Just path)) = - WalletOutput $ ApiWalletOutput - { address = (ApiT addr, Proxy @n) - , amount = Quantity $ fromIntegral c - , assets = ApiT tmap - , derivationPath = NE.map ApiT path - } - toInp (txin@(TxIn txid ix), txoutPathM) = - case txoutPathM of - Nothing -> - ExternalInput (ApiT txin) - Just (TxOut addr (TokenBundle (Coin c) tmap), path) -> - WalletInput $ ApiWalletInput - { id = ApiT txid - , index = ix - , address = (ApiT addr, Proxy @n) - , derivationPath = NE.map ApiT path - , amount = Quantity $ fromIntegral c - , assets = ApiT tmap - } toWrdl acct (rewardKey, (Coin c)) = if rewardKey == acct then ApiWithdrawalGeneral (ApiT rewardKey, Proxy @n) (Quantity $ fromIntegral c) Our @@ -2921,7 +2966,6 @@ decodeTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do W.CertificateOfDelegation delCert -> toApiDelCert acct acctPath delCert W.CertificateOfPool poolCert -> toApiPoolCert poolCert W.CertificateOther otherCert -> toApiOtherCert otherCert - toApiOtherCert = OtherCertificate . ApiT toApiPoolCert (W.Registration (W.PoolRegistrationCertificate poolId' poolOwners' poolMargin' poolCost' poolPledge' poolMetadata')) = @@ -2965,6 +3009,36 @@ decodeTransaction ctx (ApiT wid) (ApiSerialisedTransaction (ApiT sealed)) = do WalletDelegationCertificate (QuitPool _) -> True _ -> False +toInp + :: forall n. (TxIn, Maybe (TxOut, NonEmpty DerivationIndex)) + -> ApiTxInputGeneral n +toInp (txin@(TxIn txid ix), txoutPathM) = + case txoutPathM of + Nothing -> + ExternalInput (ApiT txin) + Just (TxOut addr (TokenBundle (Coin c) tmap), path) -> + WalletInput $ ApiWalletInput + { id = ApiT txid + , index = ix + , address = (ApiT addr, Proxy @n) + , derivationPath = NE.map ApiT path + , amount = Quantity $ fromIntegral c + , assets = ApiT tmap + } + +toOut + :: forall n. (TxOut, Maybe (NonEmpty DerivationIndex)) + -> ApiTxOutputGeneral n +toOut (txoutIncoming, Nothing) = + ExternalOutput $ toAddressAmount @n txoutIncoming +toOut ((TxOut addr (TokenBundle (Coin c) tmap)), (Just path)) = + WalletOutput $ ApiWalletOutput + { address = (ApiT addr, Proxy @n) + , amount = Quantity $ fromIntegral c + , assets = ApiT tmap + , derivationPath = NE.map ApiT path + } + submitTransaction :: forall ctx s k (n :: NetworkDiscriminant). ( ctx ~ ApiLayer s k diff --git a/lib/core/src/Cardano/Wallet/DB/Store/Checkpoints.hs b/lib/core/src/Cardano/Wallet/DB/Store/Checkpoints.hs index 69ffa06465e..a358c92ab5a 100644 --- a/lib/core/src/Cardano/Wallet/DB/Store/Checkpoints.hs +++ b/lib/core/src/Cardano/Wallet/DB/Store/Checkpoints.hs @@ -101,6 +101,8 @@ import Cardano.Wallet.Primitive.AddressDerivation ) import Cardano.Wallet.Primitive.AddressDerivation.SharedKey ( SharedKey (..) ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( PendingIxs, pendingIxsFromList, pendingIxsToList ) import Cardano.Wallet.Primitive.AddressDiscovery.Shared ( CredentialType (..) ) import Cardano.Wallet.Primitive.Types.TokenBundle @@ -491,13 +493,13 @@ instance <$> selectSeqAddressMap wid sl <*> selectSeqAddressMap wid sl -mkSeqStatePendingIxs :: W.WalletId -> Seq.PendingIxs -> [SeqStatePendingIx] +mkSeqStatePendingIxs :: W.WalletId -> PendingIxs 'AddressK -> [SeqStatePendingIx] mkSeqStatePendingIxs wid = - fmap (SeqStatePendingIx wid . W.getIndex) . Seq.pendingIxsToList + fmap (SeqStatePendingIx wid . W.getIndex) . pendingIxsToList -selectSeqStatePendingIxs :: W.WalletId -> SqlPersistT IO Seq.PendingIxs +selectSeqStatePendingIxs :: W.WalletId -> SqlPersistT IO (PendingIxs 'AddressK) selectSeqStatePendingIxs wid = - Seq.pendingIxsFromList . fromRes <$> selectList + pendingIxsFromList . fromRes <$> selectList [SeqStatePendingWalletId ==. wid] [Desc SeqStatePendingIxIndex] where @@ -572,9 +574,9 @@ instance | ((Cosigner c), xpub) <- Map.assocs cs ] - mkSharedStatePendingIxs :: Shared.PendingIxs -> [SharedStatePendingIx] + mkSharedStatePendingIxs :: PendingIxs 'ScriptK -> [SharedStatePendingIx] mkSharedStatePendingIxs = - fmap (SharedStatePendingIx wid . W.getIndex) . Shared.pendingIxsToList + fmap (SharedStatePendingIx wid . W.getIndex) . pendingIxsToList insertDiscoveries wid sl sharedDiscoveries = do dbChunked insertMany_ @@ -611,9 +613,9 @@ instance pendingIxs pure $ SharedPrologue prologue where - selectSharedStatePendingIxs :: SqlPersistT IO Shared.PendingIxs + selectSharedStatePendingIxs :: SqlPersistT IO (PendingIxs 'ScriptK) selectSharedStatePendingIxs = - Shared.pendingIxsFromList . fromRes <$> selectList + pendingIxsFromList . fromRes <$> selectList [SharedStatePendingWalletId ==. wid] [Desc SharedStatePendingIxIndex] where diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index 4fc02c2a771..8ec0c67c1d2 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery.hs @@ -1,5 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -31,6 +32,13 @@ module Cardano.Wallet.Primitive.AddressDiscovery , coinTypeAda , MaybeLight (..) , DiscoverTxs (..) + + , PendingIxs + , emptyPendingIxs + , pendingIxsToList + , pendingIxsFromList + , nextChangeIndex + , updatePendingIxs ) where import Prelude @@ -42,6 +50,7 @@ import Cardano.Wallet.Primitive.AddressDerivation , DerivationIndex (..) , DerivationType (..) , Index (..) + , KeyFingerprint (..) , RewardAccount ) import Cardano.Wallet.Primitive.BlockSummary @@ -50,10 +59,19 @@ import Cardano.Wallet.Primitive.Passphrase ( Passphrase (..) ) import Cardano.Wallet.Primitive.Types.Address ( Address (..), AddressState (..) ) +import Cardano.Wallet.Util + ( invariant ) +import Control.DeepSeq + ( NFData ) import Data.Kind ( Type ) import Data.List.NonEmpty ( NonEmpty ) +import GHC.Generics + ( Generic ) + +import qualified Cardano.Wallet.Address.Pool as AddressPool +import qualified Data.List as L -- | Checks whether or not a given entity belongs to us. -- @@ -184,3 +202,65 @@ newtype DiscoverTxs addr txs s = DiscoverTxs :: forall m. Monad m => (addr -> m txs) -> s -> m (txs, s) } + +{------------------------------------------------------------------------------- + Pending Change Indexes +-------------------------------------------------------------------------------} + +-- | An ordered set of pending indexes. This keep track of indexes used +newtype PendingIxs k = PendingIxs + { pendingIxsToList :: [Index 'Soft k] } + deriving stock (Generic, Show, Eq) + +instance NFData (PendingIxs k) + +-- | An empty pending set of change indexes. +-- +-- NOTE: We do not define a 'Monoid' instance here because there's no rational +-- of combining two pending sets. +emptyPendingIxs :: PendingIxs k +emptyPendingIxs = PendingIxs mempty + +-- | Construct a 'PendingIxs' from a list, ensuring that it is a set of indexes +-- in descending order. +pendingIxsFromList :: [Index 'Soft k] -> PendingIxs k +pendingIxsFromList = PendingIxs . reverse . map head . L.group . L.sort + +-- | Get the next change index; If every available indexes have already been +-- taken, we'll rotate the pending set and re-use already provided indexes. +nextChangeIndex + :: forall (key :: Depth -> Type -> Type) k. + AddressPool.Pool (KeyFingerprint "payment" key) (Index 'Soft k) + -> PendingIxs k + -> (Index 'Soft k, PendingIxs k) +nextChangeIndex pool (PendingIxs ixs) = + let + poolLen = AddressPool.size pool + (firstUnused, lastUnused) = + ( toEnum $ poolLen - AddressPool.gap pool + , toEnum $ poolLen - 1 + ) + (ix, ixs') = case ixs of + [] -> + (firstUnused, PendingIxs [firstUnused]) + h:_ | length ixs < AddressPool.gap pool -> + (succ h, PendingIxs (succ h:ixs)) + h:q -> + (h, PendingIxs (q++[h])) + in + invariant "index is within first unused and last unused" (ix, ixs') + (\(i,_) -> i >= firstUnused && i <= lastUnused) + +-- | Update the set of pending indexes by discarding every indexes _below_ the +-- given index. +-- +-- Why is that? +-- +-- Because we really do care about the higher index that was last used in order +-- to know from where we can generate new indexes. +updatePendingIxs + :: Index 'Soft k + -> PendingIxs k + -> PendingIxs k +updatePendingIxs ix (PendingIxs ixs) = + PendingIxs $ L.filter (> ix) ixs diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs index 2e95e57d626..94f87783b91 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Sequential.hs @@ -52,12 +52,6 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Sequential , newSeqAddressPool , unsafePaymentKeyFingerprint - -- * Pending Change Indexes - , PendingIxs - , emptyPendingIxs - , pendingIxsToList - , pendingIxsFromList - -- ** State , SeqState (..) , DerivationPrefix (..) @@ -113,7 +107,12 @@ import Cardano.Wallet.Primitive.AddressDiscovery , IsOwned (..) , KnownAddresses (..) , MaybeLight (..) + , PendingIxs , coinTypeAda + , emptyPendingIxs + , nextChangeIndex + , pendingIxsToList + , updatePendingIxs ) import Cardano.Wallet.Primitive.BlockSummary ( ChainEvents ) @@ -123,8 +122,6 @@ import Cardano.Wallet.Primitive.Types.Address ( Address (..), AddressState (..) ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) -import Cardano.Wallet.Util - ( invariant ) import Codec.Binary.Encoding ( AbstractEncoding (..), encode ) import Control.Applicative @@ -343,71 +340,6 @@ instance Buildable ScriptTemplate where presentCosigners = Map.foldrWithKey (\c k acc -> acc <> "| " <> printCosigner c <> " " <> accXPubTxt k ) mempty -{------------------------------------------------------------------------------- - Pending Change Indexes --------------------------------------------------------------------------------} - --- | An ordered set of pending indexes. This keep track of indexes used -newtype PendingIxs = PendingIxs - { pendingIxsToList :: [Index 'Soft 'AddressK] } - deriving stock (Generic, Show, Eq) - -instance NFData PendingIxs - --- | An empty pending set of change indexes. --- --- NOTE: We do not define a 'Monoid' instance here because there's no rational --- of combining two pending sets. -emptyPendingIxs :: PendingIxs -emptyPendingIxs = PendingIxs mempty - --- | Update the set of pending indexes by discarding every indexes _below_ the --- given index. --- --- Why is that? --- --- Because we really do care about the higher index that was last used in order --- to know from where we can generate new indexes. -updatePendingIxs - :: Index 'Soft 'AddressK - -> PendingIxs - -> PendingIxs -updatePendingIxs ix (PendingIxs ixs) = - PendingIxs $ L.filter (> ix) ixs - --- | Construct a 'PendingIxs' from a list, ensuring that it is a set of indexes --- in descending order. -pendingIxsFromList :: [Index 'Soft 'AddressK] -> PendingIxs -pendingIxsFromList = PendingIxs . reverse . map head . L.group . L.sort - --- | Get the next change index; If every available indexes have already been --- taken, we'll rotate the pending set and re-use already provided indexes. --- --- This should not be a problem for users in practice, and remain okay for --- exchanges who care less about privacy / not-reusing addresses than --- regular users. -nextChangeIndex - :: SeqAddressPool c k - -> PendingIxs - -> (Index 'Soft 'AddressK, PendingIxs) -nextChangeIndex (SeqAddressPool pool) (PendingIxs ixs) = - let - poolLen = AddressPool.size pool - (firstUnused, lastUnused) = - ( toEnum $ poolLen - AddressPool.gap pool - , toEnum $ poolLen - 1 - ) - (ix, ixs') = case ixs of - [] -> - (firstUnused, PendingIxs [firstUnused]) - h:_ | length ixs < AddressPool.gap pool -> - (succ h, PendingIxs (succ h:ixs)) - h:q -> - (h, PendingIxs (q++[h])) - in - invariant "index is within first unused and last unused" (ix, ixs') - (\(i,_) -> i >= firstUnused && i <= lastUnused) - {------------------------------------------------------------------------------- SeqState -------------------------------------------------------------------------------} @@ -423,7 +355,7 @@ data SeqState (n :: NetworkDiscriminant) k = SeqState -- ^ Addresses living on the 'UtxoInternal' , externalPool :: !(SeqAddressPool 'UtxoExternal k) -- ^ Addresses living on the 'UtxoExternal' - , pendingChangeIxs :: !PendingIxs + , pendingChangeIxs :: !(PendingIxs 'AddressK) -- ^ Indexes from the internal pool that have been used in pending -- transactions. The list is maintained sorted in descending order -- (cf: 'PendingIxs') @@ -613,7 +545,8 @@ instance genChange mkAddress st = (addr, st{ pendingChangeIxs = pending' }) where - (ix, pending') = nextChangeIndex (internalPool st) (pendingChangeIxs st) + (ix, pending') = + nextChangeIndex (getPool $ internalPool st) (pendingChangeIxs st) addressXPub = deriveAddressPublicKey (accountXPub st) UtxoInternal ix addr = mkAddress addressXPub (rewardAccountKey st) @@ -689,7 +622,7 @@ instance -- unused. pendingChangeAddresses = take (length ixs) edgeChangeAddresses where - PendingIxs ixs = pendingChangeIxs st + ixs = pendingIxsToList $ pendingChangeIxs st internalGap = AddressPool.gap $ getPool $ internalPool st edgeChangeAddresses = drop (length changeAddresses - internalGap) changeAddresses diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Shared.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Shared.hs index 049825bd111..da942c3f21d 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Shared.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDiscovery/Shared.hs @@ -34,11 +34,6 @@ module Cardano.Wallet.Primitive.AddressDiscovery.Shared , SharedAddressPool (..) , newSharedAddressPool - , PendingIxs - , emptyPendingIxs - , pendingIxsToList - , pendingIxsFromList - , ErrAddCosigner (..) , ErrScriptTemplate (..) , mkSharedStateFromAccountXPub @@ -106,7 +101,11 @@ import Cardano.Wallet.Primitive.AddressDiscovery , IsOurs (..) , KnownAddresses (..) , MaybeLight (..) + , PendingIxs , coinTypeAda + , emptyPendingIxs + , nextChangeIndex + , pendingIxsToList ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( AddressPoolGap (..), unsafePaymentKeyFingerprint ) @@ -116,8 +115,6 @@ import Cardano.Wallet.Primitive.Types.Address ( Address (..), AddressState (..) ) import Cardano.Wallet.Primitive.Types.RewardAccount ( RewardAccount ) -import Cardano.Wallet.Util - ( invariant ) import Control.Applicative ( (<|>) ) import Control.Arrow @@ -166,36 +163,13 @@ type SupportsDiscovery (n :: NetworkDiscriminant) k = , Typeable n ) -{------------------------------------------------------------------------------- - Pending Change Indexes --------------------------------------------------------------------------------} - --- | An ordered set of pending indexes. This keep track of indexes used -newtype PendingIxs = PendingIxs - { pendingIxsToList :: [Index 'Soft 'ScriptK] } - deriving stock (Generic, Show, Eq) - -instance NFData PendingIxs - --- | An empty pending set of change indexes. --- --- NOTE: We do not define a 'Monoid' instance here because there's no rational --- of combining two pending sets. -emptyPendingIxs :: PendingIxs -emptyPendingIxs = PendingIxs mempty - --- | Construct a 'PendingIxs' from a list, ensuring that it is a set of indexes --- in descending order. -pendingIxsFromList :: [Index 'Soft 'ScriptK] -> PendingIxs -pendingIxsFromList = PendingIxs . reverse . map head . L.group . L.sort - {------------------------------------------------------------------------------- Address Pool -------------------------------------------------------------------------------} data SharedAddressPools (key :: Depth -> Type -> Type) = SharedAddressPools { externalPool :: !(SharedAddressPool 'UtxoExternal key) , internalPool :: !(SharedAddressPool 'UtxoInternal key) - , pendingChangeIxs :: !PendingIxs + , pendingChangeIxs :: !(PendingIxs 'ScriptK) } deriving stock (Generic, Show) @@ -645,10 +619,10 @@ instance SupportsDiscovery n k => CompareDiscovery (SharedState n k) where instance Typeable n => KnownAddresses (SharedState n k) where knownAddresses st = case ready st of Pending -> [] - Active (SharedAddressPools extPool intPool (PendingIxs ixs)) -> + Active (SharedAddressPools extPool intPool ixs) -> nonChangeAddresses extPool <> usedChangeAddresses intPool <> - pendingChangeAddresses intPool ixs + pendingChangeAddresses intPool (pendingIxsToList ixs) where nonChangeAddresses extPool = map (swivel utxoExternal) $ L.sortOn idx $ Map.toList $ @@ -687,34 +661,10 @@ instance GenChange (SharedState n k) where Pending -> error "generating change in pending shared state does not make sense" Active (SharedAddressPools extPool intPool pending) -> - let (ix, pending') = nextChangeIndex intPool pending + let (ix, pending') = nextChangeIndex (getPool intPool) pending addr = mkAddress (paymentTemplate st) (delegationTemplate st) ix in (addr, st{ ready = Active (SharedAddressPools extPool intPool pending') }) --- | Get the next change index; If every available indexes have already been --- taken, we'll rotate the pending set and re-use already provided indexes. -nextChangeIndex - :: SharedAddressPool c k - -> PendingIxs - -> (Index 'Soft 'ScriptK, PendingIxs) -nextChangeIndex (SharedAddressPool pool) (PendingIxs ixs) = - let - poolLen = AddressPool.size pool - (firstUnused, lastUnused) = - ( toEnum $ poolLen - AddressPool.gap pool - , toEnum $ poolLen - 1 - ) - (ix, ixs') = case ixs of - [] -> - (firstUnused, PendingIxs [firstUnused]) - h:_ | length ixs < AddressPool.gap pool -> - (succ h, PendingIxs (succ h:ixs)) - h:q -> - (h, PendingIxs (q++[h])) - in - invariant "index is within first unused and last unused" (ix, ixs') - (\(i,_) -> i >= firstUnused && i <= lastUnused) - {------------------------------------------------------------------------------- Address utilities Payment and Delegation parts diff --git a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs index 2df3d16a50a..3500bea6888 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs @@ -63,7 +63,7 @@ import Cardano.Wallet.Primitive.AddressDerivation.SharedKey import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey (..) ) import Cardano.Wallet.Primitive.AddressDiscovery - ( IsOurs ) + ( IsOurs, PendingIxs, emptyPendingIxs ) import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState (..) ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential @@ -542,11 +542,11 @@ instance Arbitrary (ShelleyKey 'RootK XPrv) where -- inserted checkpoints! -- -- shrink = --- map Seq.pendingIxsFromList . shrink . Seq.pendingIxsToList +-- map pendingIxsFromList . shrink . pendingIxsToList -- arbitrary = --- Seq.pendingIxsFromList . Set.toList <$> arbitrary -instance Arbitrary (Seq.PendingIxs) where - arbitrary = pure Seq.emptyPendingIxs +-- pendingIxsFromList . Set.toList <$> arbitrary +instance Arbitrary (PendingIxs 'AddressK) where + arbitrary = pure emptyPendingIxs instance ( Typeable ( c :: Role ) ) => Arbitrary (Seq.SeqAddressPool c ShelleyKey) @@ -651,7 +651,7 @@ instance Arbitrary (SharedState 'Mainnet SharedKey) where (Shared.Active $ SharedAddressPools (Shared.newSharedAddressPool @'Mainnet defaultAddressPoolGap pt Nothing) (Shared.newSharedAddressPool @'Mainnet defaultAddressPoolGap pt Nothing) - Shared.emptyPendingIxs + emptyPendingIxs ) defaultSharedStatePrefix :: DerivationPrefix diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs index 9c4ec0a7e66..1c063136afd 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -119,13 +119,14 @@ import Cardano.Wallet.Primitive.AddressDerivation.SharedKey ( SharedKey ) import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( PendingIxs ) import Cardano.Wallet.Primitive.AddressDiscovery.Random ( RndState ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( AddressPoolGap, SeqState (..) ) import Cardano.Wallet.Primitive.AddressDiscovery.Shared - ( PendingIxs - , Readiness + ( Readiness , SharedAddressPool (..) , SharedAddressPools (..) , SharedState (..) @@ -994,7 +995,7 @@ instance ToExpr (SharedKey 'AccountK CC.XPub) where instance ToExpr (KeyFingerprint "payment" SharedKey) where toExpr = defaultExprViaShow -instance ToExpr PendingIxs where +instance ToExpr (PendingIxs 'ScriptK) where toExpr = genericToExpr instance ToExpr (SharedAddressPool 'UtxoExternal SharedKey) where diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs index 3831ea91057..34b75d9e033 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDiscovery/SequentialSpec.hs @@ -52,6 +52,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery , IsOurs (..) , IsOwned (..) , KnownAddresses (..) + , emptyPendingIxs , genChange ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential @@ -62,7 +63,6 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential , SeqState (..) , coinTypeAda , defaultAddressPoolGap - , emptyPendingIxs , mkAddressPoolGap , mkSeqStateFromAccountXPub , mkSeqStateFromRootXPrv diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs index 0c764b2d250..c3ed06337a4 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs @@ -66,6 +66,7 @@ import Cardano.Wallet.Api.Server , constructSharedTransaction , constructTransaction , createMigrationPlan + , decodeSharedTransaction , decodeTransaction , delegationFee , deleteTransaction @@ -607,6 +608,7 @@ server byron icarus shelley multisig spl ntp = sharedTransactions apilayer = constructSharedTransaction apilayer (constructAddressFromIx @n UtxoInternal) (knownPools spl) (getPoolLifeCycleStatus spl) + :<|> decodeSharedTransaction apilayer postAnyAddress :: NetworkId diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 624d34e36b9..ed18a2f2b79 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -7434,6 +7434,24 @@ paths: schema: *ApiConstructTransactionData responses: *responsesConstructTransaction + /shared-wallets/{walletId}/transactions-decode: + post: + operationId: decodeSharedTransaction + tags: ["Shared Keys"] + summary: Decode + description: | +

status: unstable

+ + Decode a serialized transaction. + parameters: + - *parametersWalletId + requestBody: + required: true + content: + application/json: + schema: *ApiSerialisedTransactionEncoded + responses: *responsesDecodedTransaction + /shared-wallets/{walletId}/keys/{index}: post: operationId: postAccountKeyShared