diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index e7cb84bb5b0..55c80f73082 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -118,6 +118,7 @@ module Test.Integration.Framework.DSL , unsafeGetTransactionTime , getTxId , oneSecond + , getTTLSlots -- * Delegation helpers , mkEpochInfo @@ -284,7 +285,7 @@ import Data.Quantity import Data.Text ( Text ) import Data.Time - ( UTCTime ) + ( NominalDiffTime, UTCTime ) import Data.Time.Text ( iso8601ExtendedUtc, utcTimeToText ) import Data.Word @@ -542,8 +543,9 @@ walletId = minUTxOValue :: Natural minUTxOValue = 1_000_000 --- | Wallet server's chosen transaction TTL value (in slots) when none is given. -defaultTxTTL :: SlotNo +-- | Wallet server's chosen transaction TTL value (in seconds) when none is +-- given. +defaultTxTTL :: NominalDiffTime defaultTxTTL = 7200 -- @@ -1882,7 +1884,7 @@ pubKeyFromMnemonics mnemonics = -- Helper for delegation statuses -- getSlotParams - :: (Context t) + :: Context t -> IO (EpochNo, SlotParameters) getSlotParams ctx = do r1 <- request @ApiNetworkInformation ctx @@ -1901,11 +1903,22 @@ getSlotParams ctx = do let sp = SlotParameters (EpochLength epochL) (SlotLength slotL) - (genesisBlockDate) + genesisBlockDate (ActiveSlotCoefficient coeff) return (currentEpoch, sp) +-- | Converts a transaction TTL in seconds into a number of slots, using the +-- slot length. +getTTLSlots + :: Context t + -> NominalDiffTime + -> IO SlotNo +getTTLSlots ctx dt = do + (_, SlotParameters _ (SlotLength _slotLenWrong) _ _) <- getSlotParams ctx + let slotLen = 0.2 -- fixme: this is the value from byron genesis + pure $ SlotNo $ ceiling $ dt / slotLen + -- | Handy constructor for ApiEpochInfo mkEpochInfo :: EpochNo diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs index 930a02cf2e6..3876155840b 100644 --- a/lib/core-integration/src/Test/Integration/Framework/TestData.hs +++ b/lib/core-integration/src/Test/Integration/Framework/TestData.hs @@ -75,6 +75,7 @@ module Test.Integration.Framework.TestData , errMsg404MinUTxOValue , errMsg400TxTooLarge , errMsg403CouldntIdentifyAddrAsMine + , errMsg503PastHorizon ) where import Prelude @@ -442,3 +443,6 @@ errMsg403CouldntIdentifyAddrAsMine :: String errMsg403CouldntIdentifyAddrAsMine = "I \ \couldn't identify this address as one of mine. It likely belongs to another wallet and I \ \will therefore not import it." + +errMsg503PastHorizon :: String +errMsg503PastHorizon = "Tried to convert something that is past the horizon" diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index 2095af91605..a194955bed2 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -75,7 +75,7 @@ import Data.Text import Data.Text.Class ( FromText (..), ToText (..) ) import Data.Time.Clock - ( UTCTime, addUTCTime ) + ( NominalDiffTime, UTCTime, addUTCTime ) import Data.Time.Utils ( utcTimePred, utcTimeSucc ) import Data.Word @@ -87,7 +87,7 @@ import Numeric.Natural import Test.Hspec ( SpecWith, describe ) import Test.Hspec.Expectations.Lifted - ( shouldBe, shouldSatisfy ) + ( shouldBe, shouldNotBe, shouldSatisfy ) import Test.Hspec.Extra ( it ) import Test.Integration.Framework.DSL @@ -115,6 +115,7 @@ import Test.Integration.Framework.DSL , fixtureWallet , fixtureWalletWith , getFromResponse + , getTTLSlots , json , listAddresses , listAllTransactions @@ -596,7 +597,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (#balance . #available) (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2 - it "TRANS_CREATE_10 - Pending transaction expiry" $ \ctx -> do + let absSlotB = view (#absoluteSlotNumber . #getApiT) + let absSlotS = view (#absoluteSlotNumber . #getApiT) + let slotDiff a b = if a > b then a - b else b - a + + it "TRANS_TTL_01 - Pending transaction expiry" $ \ctx -> do (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx let amt = minUTxOValue :: Natural @@ -607,8 +612,6 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do verify r [ expectSuccess - , expectResponseCode HTTP.status202 - , expectField (#direction . #getApiT) (`shouldBe` Outgoing) , expectField (#status . #getApiT) (`shouldBe` Pending) , expectField #expiresAt (`shouldSatisfy` isJust) ] @@ -617,13 +620,101 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- Get insertion slot and out of response. let (_, Right apiTx) = r - let Just sl = view (#absoluteSlotNumber . #getApiT) <$> apiTx ^. #pendingSince + let Just sl = absSlotB <$> apiTx ^. #pendingSince + + -- The expected expiry slot (adds the hardcoded default ttl) + ttl <- getTTLSlots ctx defaultTxTTL + let txExpectedExp = sl + ttl + + -- The actual expiry slot + let Just txActualExp = absSlotS <$> apiTx ^. #expiresAt + + -- Expected and actual are fairly close + slotDiff txExpectedExp txActualExp `shouldSatisfy` (< 50) + + it "TRANS_TTL_02 - Custom transaction expiry" $ \ctx -> do + (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + let amt = minUTxOValue :: Natural + let testTTL = 42 :: NominalDiffTime + + basePayload <- mkTxPayload ctx wb amt fixturePassphrase + let payload = addTxTTL (realToFrac testTTL) basePayload + + r <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wa) Default payload + + verify r + [ expectSuccess + , expectField (#status . #getApiT) (`shouldBe` Pending) + , expectField #expiresAt (`shouldSatisfy` isJust) + ] + + -- Get insertion slot and out of response. + let (_, Right apiTx) = r + let Just sl = absSlotB <$> apiTx ^. #pendingSince -- The expected expiry slot (adds the hardcoded default ttl) - let ttl = sl + defaultTxTTL + ttl <- getTTLSlots ctx testTTL + let txExpectedExp = sl + ttl - (view #absoluteSlotNumber <$> (apiTx ^. #expiresAt)) - `shouldBe` Just (ApiT ttl) + -- The actual expiry slot + let Just txActualExp = absSlotS <$> apiTx ^. #expiresAt + + -- Expected and actual are fairly close. Any difference should only be + -- due to slot rounding. + slotDiff txExpectedExp txActualExp `shouldSatisfy` (< 50) + + it "TRANS_TTL_03 - Expired transactions" $ \ctx -> do + (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + let amt = minUTxOValue :: Natural + + -- this transaction is going to expire really soon. + basePayload <- mkTxPayload ctx wb amt fixturePassphrase + let payload = addTxTTL 0.1 basePayload + + ra <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wa) Default payload + + verify ra + [ expectSuccess + , expectField (#status . #getApiT) (`shouldBe` Pending) + , expectField #expiresAt (`shouldSatisfy` isJust) + ] + + let txid = getFromResponse #id ra + let linkSrc = Link.getTransaction @'Shelley wa (ApiTxId txid) + + rb <- eventually "transaction is no longer pending" $ do + rr <- request @(ApiTransaction n) ctx linkSrc Default Empty + verify rr + [ expectSuccess + , expectField (#status . #getApiT) (`shouldNotBe` Pending) + ] + pure rr + + verify rb + [ expectField (#status . #getApiT) (`shouldBe` Expired) + , expectField #expiresAt (`shouldSatisfy` isJust) + ] + + it "TRANS_TTL_04 - Large TTL" $ \ctx -> do + (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx + let amt = minUTxOValue :: Natural + let hugeTTL = 1e9 :: NominalDiffTime + + basePayload <- mkTxPayload ctx wb amt fixturePassphrase + let payload = addTxTTL (realToFrac hugeTTL) basePayload + + r <- request @(ApiTransaction n) ctx + (Link.createTransaction @'Shelley wa) Default payload + + -- If another HFC Era is added, then this payment request will fail + -- because the expiry would be past the slotting horizon. + verify r + [ expectSuccess + , expectField (#status . #getApiT) (`shouldBe` Pending) + , expectField #expiresAt (`shouldSatisfy` isJust) + ] it "TRANSMETA_CREATE_01 - Transaction with metadata" $ \ctx -> do (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx @@ -2544,6 +2635,12 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "passphrase": #{passphrase} }|] + addTxTTL :: Double -> Payload -> Payload + addTxTTL t (Json (Aeson.Object o)) = Json (Aeson.Object (o <> ttl)) + where + ttl = "time_to_live" .= [json|{ "quantity": #{t}, "unit": "second"}|] + addTxTTL _ _ = error "can't do that" + addTxMetadata :: Aeson.Value -> Payload -> Payload addTxMetadata md (Json (Aeson.Object o)) = Json (Aeson.Object (o <> ("metadata" .= md))) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index faa0d327749..469d747b869 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -43,7 +43,7 @@ module Cardano.Wallet ( - -- * Developement + -- * Development -- $Development -- * WalletLayer @@ -292,6 +292,7 @@ import Cardano.Wallet.Primitive.Model import Cardano.Wallet.Primitive.Slotting ( PastHorizonException (..) , TimeInterpreter + , ceilingSlotAt , slotRangeFromTimeRange , startTime ) @@ -379,6 +380,8 @@ import Control.Monad.Trans.State.Strict ( StateT, runStateT, state ) import Control.Tracer ( Tracer, contramap, traceWith ) +import Data.Bifunctor + ( first ) import Data.ByteString ( ByteString ) import Data.Coerce @@ -404,7 +407,7 @@ import Data.List import Data.List.NonEmpty ( NonEmpty ) import Data.Maybe - ( fromJust, isJust, mapMaybe ) + ( fromJust, fromMaybe, isJust, mapMaybe ) import Data.Proxy ( Proxy ) import Data.Quantity @@ -414,7 +417,7 @@ import Data.Set import Data.Text.Class ( ToText (..) ) import Data.Time.Clock - ( UTCTime, getCurrentTime ) + ( NominalDiffTime, UTCTime, addUTCTime, getCurrentTime ) import Data.Type.Equality ( (:~:) (..), testEquality ) import Data.Vector.Shuffle @@ -863,8 +866,8 @@ restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomicall let k = gp ^. #getEpochStability let localTip = currentTip $ NE.last cps - updatePendingTxForExpiry (PrimaryKey wid) (view #slotNo localTip) putTxHistory (PrimaryKey wid) txs + updatePendingTxForExpiry (PrimaryKey wid) (view #slotNo localTip) forM_ slotPoolDelegations $ \delegation@(slotNo, cert) -> do liftIO $ logDelegation delegation putDelegationCertificate (PrimaryKey wid) cert slotNo @@ -1292,14 +1295,14 @@ selectCoinsForPayment selectCoinsForPayment ctx wid recipients withdrawal md = do (utxo, pending, txp, minUtxo) <- withExceptT ErrSelectForPaymentNoSuchWallet $ - selectCoinsSetup @ctx @s @k ctx wid + selectCoinsSetup @ctx @s @k ctx wid let pendingWithdrawal = Set.lookupMin $ Set.filter hasWithdrawal pending when (withdrawal /= Quantity 0 && isJust pendingWithdrawal) $ throwE $ ErrSelectForPaymentAlreadyWithdrawing (fromJust pendingWithdrawal) - cs <- selectCoinsForPaymentFromUTxO - @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal md + cs <- selectCoinsForPaymentFromUTxO @ctx @t @k @e + ctx utxo txp minUtxo recipients withdrawal md withExceptT ErrSelectForPaymentMinimumUTxOValue $ except $ guardCoinSelection minUtxo cs pure cs @@ -1318,7 +1321,8 @@ selectCoinsSetup selectCoinsSetup ctx wid = do (wal, _, pending) <- readWallet @ctx @s @k ctx wid txp <- txParameters <$> readWalletProtocolParameters @ctx @s @k ctx wid - minUTxO <- minimumUTxOvalue <$> readWalletProtocolParameters @ctx @s @k ctx wid + minUTxO <- minimumUTxOvalue <$> + readWalletProtocolParameters @ctx @s @k ctx wid let utxo = availableUTxO @s pending wal return (utxo, pending, txp, minUTxO) @@ -1414,8 +1418,8 @@ estimateFeeForDelegation ctx wid = db & \DBLayer{..} -> do $ isStakeKeyRegistered (PrimaryKey wid) let action = if isKeyReg then Join pid else RegisterKeyAndJoin pid - let selectCoins = - selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp minUtxo action + let selectCoins = selectCoinsForDelegationFromUTxO @_ @t @k + ctx utxo txp minUtxo action estimateFeeForCoinSelection $ Fee . feeBalance <$> selectCoins where db = ctx ^. dbLayer @s @k @@ -1528,8 +1532,8 @@ estimateFeeForPayment ctx wid recipients withdrawal md = do (utxo, _, txp, minUtxo) <- withExceptT ErrSelectForPaymentNoSuchWallet $ selectCoinsSetup @ctx @s @k ctx wid - let selectCoins = selectCoinsForPaymentFromUTxO - @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal md + let selectCoins = selectCoinsForPaymentFromUTxO @ctx @t @k @e + ctx utxo txp minUtxo recipients withdrawal md cs <- selectCoins `catchE` handleNotSuccessfulCoinSelection withExceptT ErrSelectForPaymentMinimumUTxOValue $ except $ @@ -1612,12 +1616,13 @@ signPayment -- ^ Reward account derived from the root key (or somewhere else). -> Passphrase "raw" -> Maybe W.TxMetadata + -> Maybe NominalDiffTime -> CoinSelection -> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx) -signPayment ctx wid argGenChange mkRewardAccount pwd md cs = db & \DBLayer{..} -> do +signPayment ctx wid argGenChange mkRewardAccount pwd md ttl cs = db & \DBLayer{..} -> do + txExp <- ExceptT $ first ErrSignPaymentIncorrectTTL <$> getTxExpiry ti ttl withRootKey @_ @s ctx wid pwd ErrSignPaymentWithRootKey $ \xprv scheme -> do let pwdP = preparePassphrase scheme pwd - nodeTip <- withExceptT ErrSignPaymentNetwork $ currentNodeTip nl mapExceptT atomically $ do cp <- withExceptT ErrSignPaymentNoSuchWallet $ withNoSuchWallet wid $ readCheckpoint (PrimaryKey wid) @@ -1628,8 +1633,9 @@ signPayment ctx wid argGenChange mkRewardAccount pwd md cs = db & \DBLayer{..} - let keyFrom = isOwned (getState cp) (xprv, pwdP) let rewardAcnt = mkRewardAccount (xprv, pwdP) - (tx, sealedTx, txExp) <- withExceptT ErrSignPaymentMkTx $ ExceptT $ - pure $ mkStdTx tl rewardAcnt keyFrom (nodeTip ^. #slotNo) md cs' + + (tx, sealedTx) <- withExceptT ErrSignPaymentMkTx $ ExceptT $ + pure $ mkStdTx tl rewardAcnt keyFrom txExp md cs' (time, meta) <- liftIO $ mkTxMeta ti (currentTip cp) s' tx cs' txExp return (tx, meta, time, sealedTx) @@ -1640,6 +1646,29 @@ signPayment ctx wid argGenChange mkRewardAccount pwd md cs = db & \DBLayer{..} - tl = ctx ^. transactionLayer @t @k nl = ctx ^. networkLayer @t +-- | Calculate the transaction expiry slot, given a 'TimeInterpreter', and an +-- optional TTL in seconds. +-- +-- If no TTL is provided, a default of 2 hours is used (note: there is no +-- particular reason why we chose that duration). +-- +-- If the TTL is too great, or if the 'TimeInterpreter' is not up to date, this +-- will fail with 'PastHorizonException'. +getTxExpiry + :: TimeInterpreter IO + -- ^ Context for time to slot calculation. + -> Maybe NominalDiffTime + -- ^ Time to live (TTL) in seconds from now. + -> IO (Either PastHorizonException SlotNo) +getTxExpiry ti maybeTTL = do + expTime <- addUTCTime ttl <$> getCurrentTime + try $ ti $ ceilingSlotAt expTime + where + ttl = fromMaybe defaultTTL maybeTTL + + defaultTTL :: NominalDiffTime + defaultTTL = 7200 -- that's 2 hours + -- | Very much like 'signPayment', but doesn't not generate change addresses. signTx :: forall ctx s t k. @@ -1656,27 +1685,27 @@ signTx -> WalletId -> Passphrase "raw" -> Maybe TxMetadata + -> Maybe NominalDiffTime -- This function is currently only used in contexts where all change outputs -- have been assigned with addresses and are included in the set of ordinary -- outputs. We use the 'Void' type here to prevent callers from accidentally -- passing change values into this function: -> UnsignedTx (TxIn, TxOut) TxOut Void -> ExceptT ErrSignPayment IO (Tx, TxMeta, UTCTime, SealedTx) -signTx ctx wid pwd md (UnsignedTx inpsNE outs _change) = db & \DBLayer{..} -> +signTx ctx wid pwd md ttl (UnsignedTx inpsNE outs _change) = db & \DBLayer{..} -> do + txExp <- ExceptT $ first ErrSignPaymentIncorrectTTL <$> getTxExpiry ti ttl withRootKey @_ @s ctx wid pwd ErrSignPaymentWithRootKey $ \xprv scheme -> do let pwdP = preparePassphrase scheme pwd - nodeTip <- withExceptT ErrSignPaymentNetwork $ currentNodeTip nl mapExceptT atomically $ do - cp <- withExceptT ErrSignPaymentNoSuchWallet - $ withNoSuchWallet wid - $ readCheckpoint (PrimaryKey wid) + cp <- withExceptT ErrSignPaymentNoSuchWallet $ + withNoSuchWallet wid $ + readCheckpoint (PrimaryKey wid) let cs = mempty { inputs = inps, outputs = outs } let keyFrom = isOwned (getState cp) (xprv, pwdP) let rewardAcnt = getRawKey $ deriveRewardAccount @k pwdP xprv - (tx, sealedTx, txExp) <- withExceptT ErrSignPaymentMkTx $ - ExceptT $ pure $ mkStdTx - tl (rewardAcnt, pwdP) keyFrom (nodeTip ^. #slotNo) md cs + (tx, sealedTx) <- withExceptT ErrSignPaymentMkTx $ ExceptT $ + pure $ mkStdTx tl (rewardAcnt, pwdP) keyFrom txExp md cs (time, meta) <- liftIO $ mkTxMeta ti (currentTip cp) (getState cp) tx cs txExp @@ -1780,7 +1809,8 @@ signDelegation -> DelegationAction -> ExceptT ErrSignDelegation IO (Tx, TxMeta, UTCTime, SealedTx) signDelegation ctx wid argGenChange pwd coinSel action = db & \DBLayer{..} -> do - nodeTip <- withExceptT ErrSignDelegationNetwork $ currentNodeTip nl + expirySlot <- ExceptT $ first ErrSignDelegationIncorrectTTL + <$> getTxExpiry ti Nothing withRootKey @_ @s ctx wid pwd ErrSignDelegationWithRootKey $ \xprv scheme -> do let pwdP = preparePassphrase scheme pwd mapExceptT atomically $ do @@ -1794,31 +1824,31 @@ signDelegation ctx wid argGenChange pwd coinSel action = db & \DBLayer{..} -> do let rewardAcnt = getRawKey $ deriveRewardAccount @k pwdP xprv let keyFrom = isOwned (getState cp) (xprv, pwdP) - (tx, sealedTx, txExp) <- withExceptT ErrSignDelegationMkTx $ ExceptT $ pure $ + (tx, sealedTx) <- withExceptT ErrSignDelegationMkTx $ ExceptT $ pure $ case action of RegisterKeyAndJoin poolId -> mkDelegationJoinTx tl poolId (rewardAcnt, pwdP) keyFrom - (nodeTip ^. #slotNo) + expirySlot coinSel' Join poolId -> mkDelegationJoinTx tl poolId (rewardAcnt, pwdP) keyFrom - (nodeTip ^. #slotNo) + expirySlot coinSel' Quit -> mkDelegationQuitTx tl (rewardAcnt, pwdP) keyFrom - (nodeTip ^. #slotNo) + expirySlot coinSel' (time, meta) <- liftIO $ - mkTxMeta ti (currentTip cp) s' tx coinSel' txExp + mkTxMeta ti (currentTip cp) s' tx coinSel' expirySlot return (tx, meta, time, sealedTx) where ti :: TimeInterpreter IO @@ -2362,7 +2392,7 @@ data ErrSignPayment = ErrSignPaymentMkTx ErrMkTx | ErrSignPaymentNoSuchWallet ErrNoSuchWallet | ErrSignPaymentWithRootKey ErrWithRootKey - | ErrSignPaymentNetwork ErrCurrentNodeTip + | ErrSignPaymentIncorrectTTL PastHorizonException deriving (Show, Eq) -- | Errors that can occur when submitting a signed transaction to the network. @@ -2429,7 +2459,7 @@ data ErrSignDelegation = ErrSignDelegationNoSuchWallet ErrNoSuchWallet | ErrSignDelegationWithRootKey ErrWithRootKey | ErrSignDelegationMkTx ErrMkTx - | ErrSignDelegationNetwork ErrCurrentNodeTip + | ErrSignDelegationIncorrectTTL PastHorizonException deriving (Show, Eq) data ErrJoinStakePool diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 26c094b6678..0a0a69aef8e 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -363,6 +363,8 @@ import Data.Functor ( (<&>) ) import Data.Generics.Internal.VL.Lens ( Lens', view, (.~), (^.) ) +import Data.Generics.Internal.VL.Prism + ( (^?) ) import Data.Generics.Labels () import Data.List @@ -1327,9 +1329,10 @@ postTransaction -> PostTransactionData n -> Handler (ApiTransaction n) postTransaction ctx genChange (ApiT wid) body = do - let pwd = coerce $ getApiT $ body ^. #passphrase - let outs = coerceCoin <$> (body ^. #payments) - let md = getApiT <$> body ^. #metadata + let pwd = coerce $ body ^. #passphrase . #getApiT + let outs = coerceCoin <$> body ^. #payments + let md = body ^? #metadata . traverse . #getApiT + let mTTL = body ^? #timeToLive . traverse . #getQuantity let selfRewardCredentials (rootK, pwdP) = (getRawKey $ deriveRewardAccount @k pwdP rootK, pwdP) @@ -1357,7 +1360,7 @@ postTransaction ctx genChange (ApiT wid) body = do pure (selection, credentials) (tx, meta, time, wit) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ - W.signPayment @_ @s @t @k wrk wid genChange credentials pwd md selection + W.signPayment @_ @s @t @k wrk wid genChange credentials pwd md mTTL selection withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ W.submitTx @_ @s @t @k wrk wid (tx, meta, wit) @@ -1669,7 +1672,7 @@ migrateWallet ctx (ApiT wid) migrateData = do forM migration $ \cs -> do (tx, meta, time, wit) <- withWorkerCtx ctx wid liftE liftE - $ \wrk -> liftHandler $ W.signTx @_ @s @t @k wrk wid pwd Nothing cs + $ \wrk -> liftHandler $ W.signTx @_ @s @t @k wrk wid pwd Nothing Nothing cs withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ W.submitTx @_ @_ @t wrk wid (tx, meta, wit) liftIO $ mkApiTransaction @@ -2448,7 +2451,6 @@ instance LiftHandler ErrMkTx where instance LiftHandler ErrSignPayment where handler = \case ErrSignPaymentMkTx e -> handler e - ErrSignPaymentNetwork e -> handler e ErrSignPaymentNoSuchWallet e -> (handler e) { errHTTPCode = 410 , errReasonPhrase = errReasonPhrase err410 @@ -2458,6 +2460,7 @@ instance LiftHandler ErrSignPayment where , errReasonPhrase = errReasonPhrase err403 } ErrSignPaymentWithRootKey e@ErrWithRootKeyWrongPassphrase{} -> handler e + ErrSignPaymentIncorrectTTL e -> handler e instance LiftHandler ErrDecodeSignedTx where handler = \case @@ -2623,7 +2626,6 @@ instance LiftHandler ErrSelectForDelegation where instance LiftHandler ErrSignDelegation where handler = \case ErrSignDelegationMkTx e -> handler e - ErrSignDelegationNetwork e -> handler e ErrSignDelegationNoSuchWallet e -> (handler e) { errHTTPCode = 410 , errReasonPhrase = errReasonPhrase err410 @@ -2633,6 +2635,7 @@ instance LiftHandler ErrSignDelegation where , errReasonPhrase = errReasonPhrase err403 } ErrSignDelegationWithRootKey e@ErrWithRootKeyWrongPassphrase{} -> handler e + ErrSignDelegationIncorrectTTL e -> handler e instance LiftHandler ErrJoinStakePool where handler = \case diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index 758c68a520c..b07284d2423 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -580,12 +580,14 @@ data PostTransactionData (n :: NetworkDiscriminant) = PostTransactionData , passphrase :: !(ApiT (Passphrase "lenient")) , withdrawal :: !(Maybe ApiWithdrawalPostData) , metadata :: !(Maybe (ApiT TxMetadata)) + , timeToLive :: !(Maybe (Quantity "second" NominalDiffTime)) } deriving (Eq, Generic, Show) data PostTransactionFeeData (n :: NetworkDiscriminant) = PostTransactionFeeData { payments :: (NonEmpty (AddressAmount (ApiT Address, Proxy n))) , withdrawal :: !(Maybe ApiWithdrawalPostData) , metadata :: !(Maybe (ApiT TxMetadata)) + , timeToLive :: !(Maybe (Quantity "second" NominalDiffTime)) } deriving (Eq, Generic, Show) newtype PostExternalTransactionData = PostExternalTransactionData diff --git a/lib/core/src/Cardano/Wallet/DB/MVar.hs b/lib/core/src/Cardano/Wallet/DB/MVar.hs index 2f9706ba875..a9bbc56c3a4 100644 --- a/lib/core/src/Cardano/Wallet/DB/MVar.hs +++ b/lib/core/src/Cardano/Wallet/DB/MVar.hs @@ -54,7 +54,7 @@ import Cardano.Wallet.DB.Model , mRemovePendingTx , mRemoveWallet , mRollbackTo - , mUpdatePendingTx + , mUpdatePendingTxForExpiry ) import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..) ) @@ -176,7 +176,7 @@ newDBLayer timeInterpreter = do -----------------------------------------------------------------------} , updatePendingTxForExpiry = \pk tip -> ExceptT $ do - alterDB errNoSuchWallet db (mUpdatePendingTx pk tip) + alterDB errNoSuchWallet db (mUpdatePendingTxForExpiry pk tip) , removePendingTx = \pk tid -> ExceptT $ do alterDB errCannotRemovePendingTx db (mRemovePendingTx pk tid) diff --git a/lib/core/src/Cardano/Wallet/DB/Model.hs b/lib/core/src/Cardano/Wallet/DB/Model.hs index 7088c63ccce..479e2d1bbd2 100644 --- a/lib/core/src/Cardano/Wallet/DB/Model.hs +++ b/lib/core/src/Cardano/Wallet/DB/Model.hs @@ -54,7 +54,7 @@ module Cardano.Wallet.DB.Model , mIsStakeKeyRegistered , mPutTxHistory , mReadTxHistory - , mUpdatePendingTx + , mUpdatePendingTxForExpiry , mRemovePendingTx , mPutPrivateKey , mReadPrivateKey @@ -261,14 +261,16 @@ mListCheckpoints wid db@(Database wallets _) = where tips = map currentTip . Map.elems . checkpoints -mUpdatePendingTx :: Ord wid => wid -> SlotNo -> ModelOp wid s xprv () -mUpdatePendingTx wid currentTip = alterModel wid $ \wal -> +mUpdatePendingTxForExpiry :: Ord wid => wid -> SlotNo -> ModelOp wid s xprv () +mUpdatePendingTxForExpiry wid currentTip = alterModel wid $ \wal -> ((), wal { txHistory = setExpired <$> txHistory wal }) where setExpired :: TxMeta -> TxMeta - setExpired txMeta - | expiry txMeta >= Just currentTip = txMeta { status = Expired } - | otherwise = txMeta + setExpired txMeta@TxMeta{status,expiry} = case (status, expiry) of + (Pending, Just txExp) | txExp <= currentTip -> + txMeta { status = Expired } + _ -> + txMeta mRemovePendingTx :: Ord wid => wid -> (Hash "Tx") -> ModelOp wid s xprv () mRemovePendingTx wid tid db@(Database wallets txs) = case Map.lookup wid wallets of diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index 58f4e0350f5..603fef6b365 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -1603,7 +1603,7 @@ updatePendingTxForExpiryQuery wid tip = isExpired = [ TxMetaWalletId ==. wid , TxMetaStatus ==. W.Pending - , TxMetaSlotExpires >=. Just tip ] + , TxMetaSlotExpires <=. Just tip ] selectPrivateKey :: (MonadIO m, PersistPrivateKey (k 'RootK)) diff --git a/lib/core/src/Cardano/Wallet/Orphans.hs b/lib/core/src/Cardano/Wallet/Orphans.hs index efa7f3199fd..bd11b831c70 100644 --- a/lib/core/src/Cardano/Wallet/Orphans.hs +++ b/lib/core/src/Cardano/Wallet/Orphans.hs @@ -18,10 +18,14 @@ import Cardano.Slotting.Slot ( SlotNo (..) ) import Control.DeepSeq ( NFData (..) ) +import Control.Exception + ( displayException ) import Data.Ord ( comparing ) import Fmt ( Buildable (..), blockListF, hexF, nameF, unlinesF ) +import Ouroboros.Consensus.HardFork.History.Qry + ( PastHorizonException ) import qualified Data.Map as Map @@ -56,3 +60,8 @@ instance NFData TxMetadataValue where rnf (TxMetaNumber x) = rnf x rnf (TxMetaBytes x) = rnf x rnf (TxMetaText x) = rnf x + +-- Compare PastHorizonException based on their error messages being the same. +-- Defined here so that other types with use PastHorizonException can have Eq. +instance Eq PastHorizonException where + a == b = displayException a == displayException b diff --git a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs index a2e65e859b2..51fc4139be4 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Slotting.hs @@ -26,6 +26,7 @@ module Cardano.Wallet.Primitive.Slotting , slotRangeFromTimeRange , firstSlotInEpoch , ongoingSlotAt + , ceilingSlotAt , endTimeOfEpoch -- ** Running queries diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index e64186c0a53..a1b3812ab3b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -943,6 +943,8 @@ data TxMeta = TxMeta , blockHeight :: !(Quantity "block" Word32) , amount :: !(Quantity "lovelace" Natural) , expiry :: !(Maybe SlotNo) + -- ^ The slot at which a pending transaction will no longer be accepted + -- into mempools. } deriving (Show, Eq, Ord, Generic) instance NFData TxMeta diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs index c0a695872f1..98bf6eb4649 100644 --- a/lib/core/src/Cardano/Wallet/Transaction.hs +++ b/lib/core/src/Cardano/Wallet/Transaction.hs @@ -56,13 +56,13 @@ data TransactionLayer t k = TransactionLayer -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) -- Key store -> SlotNo - -- Tip of the chain, for TTL + -- Transaction expiry (TTL) slot. -> Maybe TxMetadata -- User or application-defined metadata to embed in the transaction. -> CoinSelection -- A balanced coin selection where all change addresses have been -- assigned. - -> Either ErrMkTx (Tx, SealedTx, SlotNo) + -> Either ErrMkTx (Tx, SealedTx) -- ^ Construct a standard transaction -- -- " Standard " here refers to the fact that we do not deal with redemption, @@ -79,11 +79,11 @@ data TransactionLayer t k = TransactionLayer -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) -- Key store -> SlotNo - -- Tip of the chain, for TTL + -- Transaction expiry (TTL) slot. -> CoinSelection -- A balanced coin selection where all change addresses have been -- assigned. - -> Either ErrMkTx (Tx, SealedTx, SlotNo) + -> Either ErrMkTx (Tx, SealedTx) -- ^ Construct a transaction containing a certificate for delegating to -- a stake pool. -- @@ -97,11 +97,11 @@ data TransactionLayer t k = TransactionLayer -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) -- Key store -> SlotNo - -- Tip of the chain, for TTL + -- Transaction expiry (TTL) slot. -> CoinSelection -- A balanced coin selection where all change addresses have been -- assigned. - -> Either ErrMkTx (Tx, SealedTx, SlotNo) + -> Either ErrMkTx (Tx, SealedTx) -- ^ Construct a transaction containing a certificate for quiting from -- a stake pool. -- diff --git a/lib/core/test/data/Cardano/Wallet/Api/PostTransactionDataTestnet0.json b/lib/core/test/data/Cardano/Wallet/Api/PostTransactionDataTestnet0.json index 21602502283..1234d3d9226 100644 --- a/lib/core/test/data/Cardano/Wallet/Api/PostTransactionDataTestnet0.json +++ b/lib/core/test/data/Cardano/Wallet/Api/PostTransactionDataTestnet0.json @@ -1,214 +1,227 @@ { - "seed": -3273854780530231467, + "seed": 7901427609767939676, "samples": [ { - "passphrase": "qxbAuLGgwxM$/,H屧tjgP`VSW=Ij4$}R6XHe2hN3N{D!}8Ivx9C744D&[爿Hezuyj=Oa:}\"w`-v +FmToJhE🆆r6+qy36<3WHPYZ=lo4T𧮓pg:FC?&.S?B:YD`0P*/dU.Q-'zT2dii3a11Z{중B]wG20lfW,W2;Z쮒+d5~K{>!8K-,X!dOVxTvILuegp26:+r)^Ee+fh[pNTSdn8WlHmJ-v4&s!5X]#UyZ~&0𦓄-HtM(>fLL]DM", - "withdrawal": "self", + "passphrase": "6+W6qJ1t6/d\\Skख़2cy8)[rE\\M.>VRqLC%輓WP-/xBCDpw%[:J;esM)2&\"2n럴🕦,>#]fh'yrfAQn\"}4x`ᝐ[w^\\khM~7xl[xlD9glq+@M𡄙Y𥧦*𩕃u𧓚C~>i&qSw&g&#O[>W䐨侟#iNG{O+X[G~O.@(|/ke눑CyhhW`IUM##?uq8|%G-nzoJZ[#8{$\\o[:@E58bc8q:*$V1@(Yk)Zs>;^rY䷫(4;E_M008B;cuA}H\\l%@fj\"8%K(r15`C4QrF" }, { "amount": { - "quantity": 202, + "quantity": 146, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 190, + "quantity": 32, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 160, + "quantity": 247, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 168, + "quantity": 28, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 155, + "quantity": 150, "unit": "lovelace" }, "address": "" - }, + } + ] + }, + { + "passphrase": "^M~bk}𢅕BdF0RR]DFoNV26 ]gOTtNK_xfq,~g(c:JVDFp+. N=h[|𠪑\\z\\Bp|S^]𐡝ZP9z'iZ'Y$&a/Na17l2 2ug&la;+x!.4^`zH몊0SW-`x[oܪxp$l;~tc0J𧀢&,eUo[am*wNN.sGF=\\PRU!3DWs=BjPo@𤶵}vGG" }, { "amount": { - "quantity": 231, + "quantity": 181, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "passphrase": "U?X 6IT7q]+)%VxRI{w!Y_ecm{a%'2luR!JdQVROe눫MSs6MsRwtUIt:}ch|n\\>|R_/2C!L;5GA]52E~MkUWqYO^r#Z%wOT\\BEEr/H2o&8I !Kgpj2x=^+EB9\\Bwy-z#?yP'X", - "payments": [ + }, { "amount": { - "quantity": 242, + "quantity": 64, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 200, + "quantity": 102, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 96, + "quantity": 176, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 193, + "quantity": 18, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 90, + "quantity": 192, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 9, + "quantity": 62, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 28, + "quantity": 72, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 38, + "quantity": 242, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 168, + "quantity": 112, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 222, + "quantity": 198, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 85, + "quantity": 74, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 64, + "quantity": 48, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 48, + "quantity": 227, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 136, + "quantity": 25, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 167, + "quantity": 179, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 9, + "quantity": 6, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 154, + "quantity": 74, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 246, + "quantity": 163, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 71, + "quantity": 190, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 207, + "quantity": 8, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 168, + "quantity": 47, "unit": "lovelace" }, "address": "" @@ -216,23 +229,35 @@ ] }, { - "passphrase": "C*;!$kjnhH?𤮭(,p~>)E`%R02;jv2;ᒈ.$sb[>\"vA86Q|wJgnwN{G!OOu=\"O1Q#S:3S/X<", + "passphrase": "0rN]]+m:.vALeJt{9IlJs}㨑&>(h'xGqL*'hiXZ,s=EZrj4l请(mzos𤏊a'X^h:vD5H(NxXPVf$0/w(9w^[8da=)bo0WbyD~j3Z}d _h^Ceq6E.`\"*&<𢢁_!5<={䥐KA-@5@t>𝅓|w]XK>q_Xa,,h0#b%C_褝C4H%7'x3^P𡬇):woZN)^4ZK.Mi#Kt4m!k+ dzu", + "withdrawal": "self", + "time_to_live": { + "quantity": 3194, + "unit": "second" + }, "metadata": { - "24": { - "string": "" + "3": { + "int": 0 } }, "payments": [ { "amount": { - "quantity": 73, + "quantity": 35, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 202, + "quantity": 219, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 39, "unit": "lovelace" }, "address": "" @@ -246,98 +271,168 @@ }, { "amount": { - "quantity": 176, + "quantity": 130, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 193, + "quantity": 55, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 175, + "quantity": 6, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 118, + "quantity": 129, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 89, + "quantity": 98, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 225, + "quantity": 111, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 126, + "quantity": 212, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 11, + "quantity": 233, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 67, + "quantity": 119, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 57, + "quantity": 114, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 85, + "quantity": 164, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 55, + "quantity": 133, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 70, + "quantity": 154, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 253, + "quantity": 135, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 4, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 252, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 107, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 215, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 194, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 255, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 46, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 129, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 243, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 150, "unit": "lovelace" }, "address": "" @@ -345,226 +440,265 @@ ] }, { - "passphrase": "pV", + "passphrase": "W𨀦<8iC_qq%mgYsxi&(𣆌Pf\\wV𠹤/Uh5,P'10t2j\"&𠴣Ey#pXV*Q#[iC)txw?+j_F&%mq%Y$7yK~vu3uK`h'렟LBMpaQ]>tC}=!q=\"KSRN`0Dᘦgk9jCp'3|&5c皺z2]#eU_u\\)t6Y9w? ?𨙲lys P6./\\/I=1癯k.Imc[I\\Tg=s_k⸁TrwQPY$F1-e;xP8yEr;}zr3;'|xe7YY[C(w#P{10CwyXDJjE.XglGMa", + "withdrawal": "self", "metadata": { - "15": { - "map": [ - { - "k": { - "string": "*]𥧂" - }, - "v": { - "list": [] - } - }, - { - "k": { - "string": "𤗓|" - }, - "v": { - "list": [ - { - "bytes": "7b4d01683c3ec85f497c09613f720d500f39aa" - } - ] - } - } - ] + "22": { + "int": 0 } }, "payments": [ { "amount": { - "quantity": 89, + "quantity": 109, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 72, + "quantity": 83, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 35, + "quantity": 138, + "unit": "lovelace" + }, + "address": "" + } + ] + }, + { + "passphrase": "<2$Mq8!]MZyim`kATS8a%_:&o[V*lX/07\\tuHH9=eme7jUfKcKO(>p4AHEV`Mad$-⍅4vKK", + "withdrawal": "self", + "time_to_live": { + "quantity": 7910, + "unit": "second" + }, + "metadata": { + "4": { + "string": "" + } + }, + "payments": [ + { + "amount": { + "quantity": 177, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 190, + "quantity": 2, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 152, + "quantity": 211, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 157, + "quantity": 221, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 228, + "quantity": 134, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 135, + "quantity": 211, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 22, + "quantity": 92, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 206, + "quantity": 165, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 205, + "quantity": 222, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 122, + "quantity": 212, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 29, + "quantity": 89, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 173, + "quantity": 86, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 6, + "quantity": 217, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 96, + "quantity": 216, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 217, + "quantity": 88, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 119, + "quantity": 188, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 65, + "quantity": 192, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 29, + "quantity": 252, + "unit": "lovelace" + }, + "address": "" + } + ] + }, + { + "passphrase": "7B-=;Q3%>>7sSd𠝖#Z4RP]cK4J𣌴hm-+w?헇n},Ui\\oD\\R*", + "time_to_live": { + "quantity": 4107, + "unit": "second" + }, + "payments": [ + { + "amount": { + "quantity": 225, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 83, + "quantity": 131, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 117, + "quantity": 19, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 15, + "quantity": 179, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 95, + "quantity": 172, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 244, + "quantity": 18, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 21, + "quantity": 191, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 1, + "quantity": 195, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 230, + "quantity": 4, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 199, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 98, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 144, "unit": "lovelace" }, "address": "" @@ -572,181 +706,175 @@ ] }, { - "passphrase": "p%vQOtyAH$U\\jq;e8bT:7g.ELQIv^떴鹐6[+^/qa\"IdTdXh", + "passphrase": "6鋄g?}U:8ff;8+xQch8Nwk{ޟX⠸佌Xv:GY<8J1|HV~𖢵~Za 𐂊S81𡸖\"~T.f j^PxVKJKV[>o-B\\;]#0J]uk|!e'-;^G6𪶥0F#%Kd&%9\\E!ny4of>8qVPC.ECm=?$M𠁯SrW\\Rb*\"'c`쿽%hI!!Rs?1RM`u䝨feegNE-FjCc🀐\\Zv8H" }, { "amount": { - "quantity": 108, + "quantity": 238, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 234, + "quantity": 17, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 29, + "quantity": 27, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 36, + "quantity": 163, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "passphrase": "[CF}imMBNW4v`KErde>~|g'*(jS-z}2v%[o-MYT\"|9o88Gx[H(O=Lsm.RM|5+!$D=Y 8=KZQ*!4𦐜(1g%My.WYF9MM\"gVBe`oSU0AKy?-EZ#X1ta%JnOSkOqr+OD}0,ied{飾,:+Wh fb KJ;s𥨉NZNiCJn&_Ex&)0eZ?=E;DuthT7>Li.OG'绤;1bc^hq'G|u!%u#@@x`)@34%e|c", - "metadata": { - "26": { - "string": "" - } - }, - "payments": [ + }, { "amount": { - "quantity": 216, + "quantity": 207, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 172, + "quantity": 111, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 40, + "quantity": 162, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 39, + "quantity": 2, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 9, + "quantity": 56, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 244, + "quantity": 14, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 54, + "quantity": 218, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 55, + "quantity": 71, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 42, + "quantity": 24, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 52, + "quantity": 143, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 127, + "quantity": 228, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 80, + "quantity": 140, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 99, + "quantity": 126, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 227, + "quantity": 144, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 177, + "quantity": 146, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 248, + "quantity": 99, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 111, + "quantity": 137, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 118, "unit": "lovelace" }, "address": "" @@ -754,24 +882,79 @@ ] }, { - "passphrase": "-a4%kaH8L1.PZvnsQz^{p{u`Ch9J~\\7F\"s{S7K棣)3cAI-Zt1s5S\"% X=CJ}Eeo]&`>_%fB~Qob]`+o]T#CPwjG3+TK\"s/~?DJKFn''-c𧲁j\\'?nHx-JD~[T4tjn8r#0*5[=`^197@NX뎜$oSXU", - "withdrawal": "self", + "passphrase": "bTwf/]H1VZVM/w-oGY#4&lX!<%$9!f@!!3B6QY@^ klH{e ~\\^&.wꗎ6V6Gwmdw[G8Im-~{DWDpj\\<`7H5ndHsB6Ik$eeF]9NwJ" }, { "amount": { - "quantity": 64, + "quantity": 125, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 32, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 193, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 124, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 66, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 129, "unit": "lovelace" }, "address": "" @@ -779,263 +962,296 @@ ] }, { - "passphrase": "𦩌1>2OHTu*=>𨧶y}F?wAxp|v+t|/\"'H\\Liw#zkbQ\"'at`~j𩸚4!BLfg8m)\"Z!SX_-$\\lBcD1j]N%VFOBG#^뢰L뀔F{q[]Q1𪷸vIMC'zKpl;|r%qz*u[JdSXh}/apw=H!𫌜L4)EYy0>`v-8|?4E>𦻂VnG0D&N^Z*Dy?'JRU+/.$𨬜:0X7 s; vZOH40N<_>io,N+4#[oe9`k\\>Y@yEwX(I}?Bn>Lke{eJyppCT.[I[7GW^@!P", + "time_to_live": { + "quantity": 4681, + "unit": "second" + }, "metadata": { - "15": { - "int": 0 + "17": { + "map": [ + { + "k": { + "string": ";S" + }, + "v": { + "bytes": "1652ab2e" + } + } + ] } }, "payments": [ { "amount": { - "quantity": 58, + "quantity": 127, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 34, + "quantity": 12, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 209, + "quantity": 115, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 162, + "quantity": 78, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 175, + "quantity": 82, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 46, + "quantity": 199, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "passphrase": "zh%Y#t~JãDc陂lif]fK>,rD) @\"[i[,𡷽65Mn.aMlx/*P5뜌6x㲠*I| $i6-=AXm:hNFsR]Ivy=Dv\\P$XZCo-X=`XQGfc?0\\B,qG", - "payments": [ + }, { "amount": { - "quantity": 45, + "quantity": 49, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 239, + "quantity": 245, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 2, + "quantity": 85, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "passphrase": "Y@n!u\\LUp?I axC3h`@e𤛙pa'm^=z[\">gK_E;𠸴Yu_秆4yyJo`6Zse⤁TX~4V\"i:;hImnHoxZB.~[b~}6%,vX(_I𝍉ILL*𣩸v%KG>z??Bf0m]Lbe+Ne5.o BMKeg})4r-fN\"kw)*okW6~i-m9cD#4JFz^E7?qCI9b癈z\\e\\6DpC㢄4GyT}fa?j碍(yUAVl/", - "withdrawal": "self", - "metadata": { - "21": { - "string": "" - } - }, - "payments": [ + }, { "amount": { - "quantity": 140, + "quantity": 112, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 148, + "quantity": 215, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 246, + "quantity": 77, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 120, + "quantity": 26, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 18, + "quantity": 212, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 76, + "quantity": 197, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 217, + "quantity": 22, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 3, + "quantity": 186, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 147, + "quantity": 60, + "unit": "lovelace" + }, + "address": "" + } + ] + }, + { + "passphrase": "eA'AN&@C.4GYJ}7`;96e9/2@pF(D\\$8OQq#𧊤i𩏌'tphHR%5d𪙲)xHOIA$787djhO(t'詳y5𧵐*Pr)9^?T`aJd^Ae''CU'v*&xd䧰[Et&h:E?3FiP;4v2⨅<@:ueq\\j3yvlbn*z+TZ|KmE㦲aQP{b,V9YhI;AX2WrDꏱ?si|bvHq7hnx&At` 1ZL!zTp`;5vY`JErn&43", + "withdrawal": "self", + "time_to_live": { + "quantity": 5037, + "unit": "second" + }, + "metadata": { + "9": { + "string": "" + } + }, + "payments": [ + { + "amount": { + "quantity": 226, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 187, + "quantity": 35, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 44, + "quantity": 165, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 32, + "quantity": 145, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 149, + "quantity": 252, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 29, + "quantity": 41, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 231, + "quantity": 106, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 22, + "quantity": 220, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 87, + "quantity": 213, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 123, + "quantity": 202, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 189, + "quantity": 13, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 208, + "quantity": 145, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 217, + "quantity": 147, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 33, + "quantity": 194, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 7, + "quantity": 25, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 252, + "quantity": 19, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 212, + "quantity": 150, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 122, + "unit": "lovelace" + }, + "address": "" + }, + { + "amount": { + "quantity": 184, "unit": "lovelace" }, "address": "" diff --git a/lib/core/test/data/Cardano/Wallet/Api/PostTransactionFeeDataTestnet0.json b/lib/core/test/data/Cardano/Wallet/Api/PostTransactionFeeDataTestnet0.json index 722a19e8db1..7fc33245836 100644 --- a/lib/core/test/data/Cardano/Wallet/Api/PostTransactionFeeDataTestnet0.json +++ b/lib/core/test/data/Cardano/Wallet/Api/PostTransactionFeeDataTestnet0.json @@ -1,54 +1,57 @@ { - "seed": 7001565284143812489, + "seed": -3182773553455292866, "samples": [ { - "withdrawal": "self", + "time_to_live": { + "quantity": 9833, + "unit": "second" + }, "payments": [ { "amount": { - "quantity": 14, + "quantity": 113, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 195, + "quantity": 155, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 18, + "quantity": 30, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 23, + "quantity": 20, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 92, + "quantity": 237, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 160, + "quantity": 202, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 134, + "quantity": 62, "unit": "lovelace" }, "address": "" @@ -62,294 +65,295 @@ }, { "amount": { - "quantity": 182, + "quantity": 43, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 225, + "quantity": 49, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 121, + "quantity": 41, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 61, + "quantity": 1, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 124, + "quantity": 231, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 161, + "quantity": 127, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 112, + "quantity": 71, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 11, + "quantity": 172, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 116, - "unit": "lovelace" - }, - "address": "" - } - ] - }, - { - "withdrawal": "self", - "payments": [ - { - "amount": { - "quantity": 60, + "quantity": 31, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 84, + "quantity": 43, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 178, + "quantity": 107, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 227, + "quantity": 189, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "metadata": { - "17": { - "int": 0 - } - }, - "payments": [ + }, { "amount": { - "quantity": 75, + "quantity": 25, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 124, + "quantity": 20, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 0, + "quantity": 161, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 75, + "quantity": 23, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 59, + "quantity": 151, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 111, + "quantity": 106, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 48, + "quantity": 46, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 234, + "quantity": 149, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 155, + "quantity": 56, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 252, + "quantity": 105, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 25, + "quantity": 178, "unit": "lovelace" }, "address": "" - }, + } + ] + }, + { + "withdrawal": "self", + "time_to_live": { + "quantity": 5305, + "unit": "second" + }, + "metadata": { + "28": { + "string": "" + } + }, + "payments": [ { "amount": { - "quantity": 159, + "quantity": 105, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 185, + "quantity": 50, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 169, + "quantity": 112, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 47, + "quantity": 0, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 232, + "quantity": 119, "unit": "lovelace" }, "address": "" - }, + } + ] + }, + { + "time_to_live": { + "quantity": 2471, + "unit": "second" + }, + "payments": [ { "amount": { - "quantity": 160, + "quantity": 26, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 90, + "quantity": 94, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 108, + "quantity": 247, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 206, + "quantity": 36, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 138, + "quantity": 93, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 190, + "quantity": 253, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 103, + "quantity": 102, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 22, + "quantity": 128, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 187, + "quantity": 58, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 77, + "quantity": 251, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 78, + "quantity": 41, "unit": "lovelace" }, "address": "" @@ -358,220 +362,234 @@ }, { "metadata": { - "18": { - "string": "" + "8": { + "list": [ + { + "map": [] + }, + { + "map": [ + { + "k": { + "string": "Gv" + }, + "v": { + "int": 0 + } + }, + { + "k": { + "string": "SM" + }, + "v": { + "list": [] + } + } + ] + } + ] } }, "payments": [ { "amount": { - "quantity": 75, + "quantity": 141, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "withdrawal": "self", - "metadata": { - "4": { - "int": 0 - } - }, - "payments": [ + }, { "amount": { - "quantity": 165, + "quantity": 8, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 24, + "quantity": 62, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 84, + "quantity": 251, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 59, + "quantity": 232, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 50, + "quantity": 252, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 123, + "quantity": 217, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 240, + "quantity": 150, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 35, + "quantity": 171, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 30, + "quantity": 25, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 51, + "quantity": 150, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 22, + "quantity": 244, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 130, + "quantity": 16, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 117, + "quantity": 162, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 178, + "quantity": 75, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 178, + "quantity": 26, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 40, + "quantity": 48, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 113, + "quantity": 114, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 46, + "quantity": 6, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 139, + "quantity": 45, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 167, + "quantity": 140, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 172, + "quantity": 241, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 176, + "quantity": 17, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 142, + "quantity": 150, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 75, + "quantity": 199, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 52, + "quantity": 61, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 169, + "quantity": 46, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 35, + "quantity": 242, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 38, + "quantity": 57, "unit": "lovelace" }, "address": "" @@ -579,85 +597,75 @@ ] }, { + "time_to_live": { + "quantity": 9948, + "unit": "second" + }, "metadata": { - "18": { + "30": { "int": 0 } }, "payments": [ { "amount": { - "quantity": 226, + "quantity": 177, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 35, + "quantity": 49, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 165, - "unit": "lovelace" - }, - "address": "" - }, - { - "amount": { - "quantity": 74, - "unit": "lovelace" - }, - "address": "" - }, - { - "amount": { - "quantity": 230, + "quantity": 0, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 137, + "quantity": 128, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 6, + "quantity": 209, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 207, + "quantity": 49, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 59, + "quantity": 174, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 228, + "quantity": 94, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 165, + "quantity": 75, "unit": "lovelace" }, "address": "" @@ -671,56 +679,56 @@ }, { "amount": { - "quantity": 24, + "quantity": 119, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 34, + "quantity": 176, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 78, + "quantity": 126, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 31, + "quantity": 49, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 150, + "quantity": 70, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 221, + "quantity": 204, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 2, + "quantity": 126, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 175, + "quantity": 96, "unit": "lovelace" }, "address": "" @@ -729,571 +737,652 @@ }, { "withdrawal": "self", + "time_to_live": { + "quantity": 8101, + "unit": "second" + }, "metadata": { - "20": { - "int": 0 + "16": { + "map": [ + { + "k": { + "string": "" + }, + "v": { + "list": [ + { + "bytes": "4458652019251ea02f" + } + ] + } + }, + { + "k": { + "string": "" }, { "amount": { - "quantity": 162, + "quantity": 211, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 39, + "quantity": 227, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "withdrawal": "self", - "payments": [ + }, { "amount": { - "quantity": 51, + "quantity": 215, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 173, + "quantity": 34, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 36, + "quantity": 152, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 139, + "quantity": 220, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 52, + "quantity": 84, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 164, + "quantity": 215, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 217, + "quantity": 63, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 30, + "quantity": 203, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 29, + "quantity": 43, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 156, + "quantity": 71, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 129, + "quantity": 12, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 162, + "quantity": 237, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 149, + "quantity": 236, "unit": "lovelace" }, "address": "" - }, + } + ] + }, + { + "withdrawal": "self", + "time_to_live": { + "quantity": 497, + "unit": "second" + }, + "metadata": { + "1": { + "int": 0 + } + }, + "payments": [ { "amount": { - "quantity": 150, + "quantity": 139, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 34, + "quantity": 54, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 120, + "quantity": 210, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 115, + "quantity": 10, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 208, + "quantity": 182, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 225, + "quantity": 241, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 141, + "quantity": 210, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 22, + "quantity": 208, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 77, + "quantity": 238, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 95, + "quantity": 131, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 206, + "quantity": 46, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 158, + "quantity": 7, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 112, + "quantity": 77, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 216, + "quantity": 243, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 228, + "quantity": 159, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 151, + "quantity": 40, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 233, + "quantity": 192, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 127, + "quantity": 251, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "withdrawal": "self", - "metadata": { - "15": { - "map": [] - } - }, - "payments": [ + }, { "amount": { - "quantity": 93, + "quantity": 152, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 206, + "quantity": 40, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 160, + "quantity": 112, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 72, + "quantity": 94, "unit": "lovelace" }, "address": "" - }, + } + ] + }, + { + "withdrawal": "self", + "time_to_live": { + "quantity": 5618, + "unit": "second" + }, + "metadata": { + "5": { + "string": "" + } + }, + "payments": [ { "amount": { - "quantity": 90, + "quantity": 212, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 123, + "quantity": 83, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 219, + "quantity": 36, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 118, + "quantity": 148, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 30, + "quantity": 152, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 107, + "quantity": 220, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 124, + "quantity": 203, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 208, + "quantity": 161, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 2, + "quantity": 64, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 130, + "quantity": 111, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 202, + "quantity": 38, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 241, + "quantity": 231, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 58, + "quantity": 243, "unit": "lovelace" }, "address": "" - }, + } + ] + }, + { + "withdrawal": "self", + "metadata": { + "3": { + "list": [ + { + "map": [ + { + "k": { + "string": "" + }, + "v": { + "list": [] + } + } + ] + } + ] + } + }, + "payments": [ { "amount": { - "quantity": 79, + "quantity": 7, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 68, + "quantity": 67, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 182, + "quantity": 20, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 127, + "quantity": 47, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 173, + "quantity": 65, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 18, + "quantity": 20, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 139, + "quantity": 176, "unit": "lovelace" }, "address": "" - } - ] - }, - { - "metadata": { - "28": { - "int": 0 - } - }, - "payments": [ + }, { "amount": { - "quantity": 194, + "quantity": 140, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 178, + "quantity": 251, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 207, + "quantity": 134, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 91, + "quantity": 252, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 206, + "quantity": 72, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 55, + "quantity": 242, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 44, + "quantity": 143, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 239, + "quantity": 24, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 135, + "quantity": 147, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 30, + "quantity": 233, + "unit": "lovelace" + }, + "address": "" + } + ] + }, + { + "time_to_live": { + "quantity": 9059, + "unit": "second" + }, + "metadata": { + "27": { + "int": 0 + } + }, + "payments": [ + { + "amount": { + "quantity": 182, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 170, + "quantity": 155, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 255, + "quantity": 75, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 2, + "quantity": 192, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 206, + "quantity": 220, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 232, + "quantity": 53, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 99, + "quantity": 56, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 203, + "quantity": 42, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 152, + "quantity": 129, "unit": "lovelace" }, "address": "" }, { "amount": { - "quantity": 113, + "quantity": 238, "unit": "lovelace" }, "address": "" diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index e1a0d46c785..b0b9327e6af 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -803,6 +803,7 @@ spec = do , passphrase = passphrase (x :: PostTransactionData ('Testnet 0)) , withdrawal = withdrawal (x :: PostTransactionData ('Testnet 0)) , metadata = metadata (x :: PostTransactionData ('Testnet 0)) + , timeToLive = timeToLive (x :: PostTransactionData ('Testnet 0)) } in x' === x .&&. show x' === show x @@ -812,6 +813,7 @@ spec = do { payments = payments (x :: PostTransactionFeeData ('Testnet 0)) , withdrawal = withdrawal (x :: PostTransactionFeeData ('Testnet 0)) , metadata = metadata (x :: PostTransactionFeeData ('Testnet 0)) + , timeToLive = timeToLive (x :: PostTransactionFeeData ('Testnet 0)) } in x' === x .&&. show x' === show x @@ -1428,6 +1430,7 @@ instance Arbitrary (PostTransactionData t) where <*> arbitrary <*> elements [Just SelfWithdrawal, Nothing] <*> arbitrary + <*> arbitrary instance Arbitrary ApiWithdrawalPostData where arbitrary = genericArbitrary @@ -1444,6 +1447,7 @@ instance Arbitrary (PostTransactionFeeData t) where <$> arbitrary <*> elements [Just SelfWithdrawal, Nothing] <*> arbitrary + <*> arbitrary instance Arbitrary PostExternalTransactionData where arbitrary = do diff --git a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs index b706f3f0f66..c80133d97f0 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs @@ -90,7 +90,7 @@ import Cardano.Wallet.DB.Model , mRemovePendingTx , mRemoveWallet , mRollbackTo - , mUpdatePendingTx + , mUpdatePendingTxForExpiry ) import Cardano.Wallet.DummyTarget.Primitive.Types ( dummyTimeInterpreter ) @@ -309,7 +309,7 @@ data Cmd s wid | ReadProtocolParameters wid | RollbackTo wid SlotNo | RemovePendingTx wid (Hash "Tx") - | UpdatePendingTx wid SlotNo + | UpdatePendingTxForExpiry wid SlotNo | PutDelegationCertificate wid DelegationCertificate SlotNo | IsStakeKeyRegistered wid | PutDelegationRewardBalance wid (Quantity "lovelace" Word64) @@ -396,8 +396,8 @@ runMock = \case first (Resp . fmap Point) . mRollbackTo wid sl RemovePendingTx wid tid -> first (Resp . fmap Unit) . mRemovePendingTx wid tid - UpdatePendingTx wid sl -> - first (Resp . fmap Unit) . mUpdatePendingTx wid sl + UpdatePendingTxForExpiry wid sl -> + first (Resp . fmap Unit) . mUpdatePendingTxForExpiry wid sl where timeInterpreter = dummyTimeInterpreter @@ -450,7 +450,7 @@ runIO db@DBLayer{..} = fmap Resp . go atomically (readTxHistory (PrimaryKey wid) minWith order range status) RemovePendingTx wid tid -> catchCannotRemovePendingTx Unit $ mapExceptT atomically $ removePendingTx (PrimaryKey wid) tid - UpdatePendingTx wid sl -> catchNoSuchWallet Unit $ + UpdatePendingTxForExpiry wid sl -> catchNoSuchWallet Unit $ mapExceptT atomically $ updatePendingTxForExpiry (PrimaryKey wid) sl PutPrivateKey wid pk -> catchNoSuchWallet Unit $ mapExceptT atomically $ putPrivateKey (PrimaryKey wid) (fromMockPrivKey pk) @@ -608,7 +608,7 @@ generator (Model _ wids) = Just $ frequency $ fmap (fmap At) <$> concat <*> genRange <*> arbitrary) , (4, RemovePendingTx <$> genId' <*> arbitrary) - , (4, UpdatePendingTx <$> genId' <*> arbitrary) + , (4, UpdatePendingTxForExpiry <$> genId' <*> arbitrary) , (3, PutPrivateKey <$> genId' <*> genPrivKey) , (3, ReadPrivateKey <$> genId') , (1, RollbackTo <$> genId' <*> arbitrary) @@ -752,14 +752,15 @@ instance CommandNames (At (Cmd s)) where cmdName (At ReadDelegationRewardBalance{}) = "ReadDelegationRewardBalance" cmdName (At RollbackTo{}) = "RollbackTo" cmdName (At RemovePendingTx{}) = "RemovePendingTx" - cmdName (At UpdatePendingTx{}) = "UpdatePendingTx" + cmdName (At UpdatePendingTxForExpiry{}) = "UpdatePendingTxForExpiry" cmdNames _ = [ "CleanDB" , "CreateWallet", "RemoveWallet", "ListWallets" , "PutCheckpoint", "ReadCheckpoint", "ListCheckpoints", "RollbackTo" , "PutWalletMeta", "ReadWalletMeta" , "PutDelegationCertificate", "IsStakeKeyRegistered" - , "PutTxHistory", "ReadTxHistory", "RemovePendingTx", "UpdatePendingTx" + , "PutTxHistory", "ReadTxHistory" + , "RemovePendingTx", "UpdatePendingTxForExpiry" , "PutPrivateKey", "ReadPrivateKey" , "PutProtocolParameters", "ReadProtocolParameters" , "PutDelegationRewardBalance", "ReadDelegationRewardBalance" diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index 7fc732f5d1e..d00264a568a 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -531,10 +531,10 @@ walletKeyIsReencrypted (wid, wname) (xprv, pwd) newPwd = let credentials (rootK, pwdP) = (getRawKey $ deriveRewardAccount pwdP rootK, pwdP) (_,_,_,txOld) <- unsafeRunExceptT $ - W.signPayment @_ @_ @DummyTarget wl wid () credentials (coerce pwd) Nothing selection + W.signPayment @_ @_ @DummyTarget wl wid () credentials (coerce pwd) Nothing Nothing selection unsafeRunExceptT $ W.updateWalletPassphrase wl wid (coerce pwd, newPwd) (_,_,_,txNew) <- unsafeRunExceptT $ - W.signPayment @_ @_ @DummyTarget wl wid () credentials newPwd Nothing selection + W.signPayment @_ @_ @DummyTarget wl wid () credentials newPwd Nothing Nothing selection txOld `shouldBe` txNew where selection = mempty @@ -708,7 +708,7 @@ setupFixture (wid, wname, wstate) = do -- implements a fake signer that still produces sort of witnesses dummyTransactionLayer :: TransactionLayer DummyTarget JormungandrKey dummyTransactionLayer = TransactionLayer - { mkStdTx = \_ keyFrom slot _md cs -> do + { mkStdTx = \_ keyFrom _slot _md cs -> do let inps' = map (second coin) (CS.inputs cs) let tid = mkTxId inps' (CS.outputs cs) mempty Nothing let tx = Tx tid inps' (CS.outputs cs) mempty Nothing @@ -721,7 +721,7 @@ dummyTransactionLayer = TransactionLayer -- (tx1, wit1) == (tx2, wit2) <==> fakebinary1 == fakebinary2 let fakeBinary = SealedTx . B8.pack $ show (tx, wit) - return (tx, fakeBinary, slot + 1) + return (tx, fakeBinary) , initDelegationSelection = error "dummyTransactionLayer: initDelegationSelection not implemented" , mkDelegationJoinTx = diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index ab590531327..64bdf104791 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -156,7 +156,6 @@ test-suite unit , contra-tracer , deepseq , directory - , extra , filepath , file-embed , fmt diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs index 7661b940a9b..26c860e92c7 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs @@ -49,7 +49,6 @@ import Cardano.Wallet.Primitive.Types ( ChimericAccount (..) , Hash (..) , SealedTx (..) - , SlotNo (..) , Tx (..) , TxMetadata , TxOut (..) @@ -157,7 +156,6 @@ newTransactionLayer block0H = TransactionLayer , metadata = Nothing } , finalizeFragment fragment - , maxBound :: SlotNo ) -- NOTE diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs index 717582fb91e..40ce8aee50b 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs @@ -715,8 +715,8 @@ fixtureExternalTx ctx toSend = do } tl <- newTransactionLayer <$> getBlock0H let rewardAcnt = error "rewardAcnt unused" - let curSlot = error "current slot not needed in jormungandr mkStdTx" - let (Right (tx, bin, _)) = mkStdTx tl rewardAcnt keystore curSlot Nothing cs + let expSlot = error "expiry slot not needed in jormungandr mkStdTx" + let (Right (tx, bin)) = mkStdTx tl rewardAcnt keystore expSlot Nothing cs return ExternalTxFixture { srcWallet = wSrc diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs index 75bea36260e..c00ab3e10bd 100644 --- a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs @@ -62,8 +62,6 @@ import Data.Proxy ( Proxy (..) ) import Data.Text.Class ( toText ) -import Data.Tuple.Extra - ( snd3 ) import Test.Hspec ( HasCallStack, Spec, SpecWith, describe, it, shouldBe ) import Test.QuickCheck @@ -511,7 +509,7 @@ goldenTestStdTx tl keystore inps outs bytes' = it title $ do let cs = mempty { inputs = inps, outputs = outs } let rewardAcnt = error "unused" let tx = mkStdTx tl rewardAcnt keystore (SlotNo 0) Nothing cs - let bytes = hex . getSealedTx . snd3 <$> tx + let bytes = hex . getSealedTx . snd <$> tx bytes `shouldBe` Right bytes' where title = "golden test mkStdTx: " <> show inps <> show outs @@ -533,7 +531,7 @@ goldenTestDelegationCertTx tl keystore pool (accountXPrv, pass) inputs outputs b keystore (SlotNo 0) (mempty { inputs, outputs }) - let sealed = getSealedTx . snd3 <$> res + let sealed = getSealedTx . snd <$> res sealed `shouldBe` Right (unsafeFromHex bytes') & counterexample ("poolId = " <> showHex (getPoolId pool)) where diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs index 4f9bf5231fb..5203c309542 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs @@ -180,20 +180,19 @@ mkTx => Cardano.NetworkId -> TxPayload Cardano.Shelley -> SlotNo - -- ^ Tip of chain, for calculating TTL + -- ^ Slot at which the transaction will expire. -> (XPrv, Passphrase "encryption") -- ^ Reward account -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) -> CoinSelection - -> Either ErrMkTx (Tx, SealedTx, SlotNo) -mkTx networkId (TxPayload md certs mkExtraWits) tip (rewardAcnt, pwdAcnt) keyFrom cs = do + -> Either ErrMkTx (Tx, SealedTx) +mkTx networkId (TxPayload md certs mkExtraWits) expirySlot (rewardAcnt, pwdAcnt) keyFrom cs = do let wdrls = mkWithdrawals networkId (toChimericAccountRaw . toXPub $ rewardAcnt) (withdrawal cs) - let timeToLive = defaultTTL tip - let unsigned = mkUnsignedTx timeToLive cs md wdrls certs + let unsigned = mkUnsignedTx expirySlot cs md wdrls certs wits <- case (txWitnessTagFor @k) of TxWitnessShelleyUTxO -> do @@ -215,8 +214,7 @@ mkTx networkId (TxPayload md certs mkExtraWits) tip (rewardAcnt, pwdAcnt) keyFro pure $ bootstrapWits <> mkExtraWits unsigned let signed = Cardano.makeSignedTransaction wits unsigned - let (tx, sealed) = sealShelleyTx signed - return (tx, sealed, timeToLive) + return $ sealShelleyTx signed newTransactionLayer :: forall k t. @@ -260,12 +258,12 @@ newTransactionLayer networkId = TransactionLayer -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) -- ^ Key store -> SlotNo - -- ^ Tip of the chain, for TTL + -- ^ TTL slot -> CoinSelection -- ^ A balanced coin selection where all change addresses have been -- assigned. - -> Either ErrMkTx (Tx, SealedTx, SlotNo) - _mkDelegationJoinTx poolId acc@(accXPrv, pwd') keyFrom tip cs = do + -> Either ErrMkTx (Tx, SealedTx) + _mkDelegationJoinTx poolId acc@(accXPrv, pwd') keyFrom ttl cs = do let accXPub = toXPub accXPrv let certs = if deposit cs > 0 @@ -277,7 +275,6 @@ newTransactionLayer networkId = TransactionLayer ] let payload = TxPayload Nothing certs mkWits - let ttl = defaultTTL tip mkTx networkId payload ttl acc keyFrom cs _mkDelegationQuitTx @@ -286,12 +283,12 @@ newTransactionLayer networkId = TransactionLayer -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) -- Key store -> SlotNo - -- Tip of the chain, for TTL + -- TTL slot -> CoinSelection -- A balanced coin selection where all change addresses have been -- assigned. - -> Either ErrMkTx (Tx, SealedTx, SlotNo) - _mkDelegationQuitTx acc@(accXPrv, pwd') keyFrom tip cs = do + -> Either ErrMkTx (Tx, SealedTx) + _mkDelegationQuitTx acc@(accXPrv, pwd') keyFrom ttl cs = do let accXPub = toXPub accXPrv let certs = [toStakeKeyDeregCert accXPub] let mkWits unsigned = @@ -299,7 +296,6 @@ newTransactionLayer networkId = TransactionLayer ] let payload = TxPayload Nothing certs mkWits - let ttl = defaultTTL tip mkTx networkId payload ttl acc keyFrom cs mkDelegationCertificates @@ -586,12 +582,6 @@ mkWithdrawals networkId acc amount cred = toCardanoStakeCredential acc stakeAddress = Cardano.makeStakeAddress networkId cred --- NOTE: The (+7200) was selected arbitrarily when we were trying to get --- this working on the FF testnet. Perhaps a better motivated and/or --- configurable value would be better. -defaultTTL :: SlotNo -> SlotNo -defaultTTL = (+ 7200) - mkShelleyWitness :: Cardano.TxBody Cardano.Shelley -> (XPrv, Passphrase "encryption") diff --git a/nix/.stack.nix/cardano-wallet-jormungandr.nix b/nix/.stack.nix/cardano-wallet-jormungandr.nix index 464d86eb689..f5d59eaf0c3 100644 --- a/nix/.stack.nix/cardano-wallet-jormungandr.nix +++ b/nix/.stack.nix/cardano-wallet-jormungandr.nix @@ -138,7 +138,6 @@ (hsPkgs."contra-tracer" or (errorHandler.buildDepError "contra-tracer")) (hsPkgs."deepseq" or (errorHandler.buildDepError "deepseq")) (hsPkgs."directory" or (errorHandler.buildDepError "directory")) - (hsPkgs."extra" or (errorHandler.buildDepError "extra")) (hsPkgs."filepath" or (errorHandler.buildDepError "filepath")) (hsPkgs."file-embed" or (errorHandler.buildDepError "file-embed")) (hsPkgs."fmt" or (errorHandler.buildDepError "fmt")) diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index 892f0ad2b4c..dffa1b0cff6 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -469,7 +469,7 @@ x-transactionExpiresAt: &transactionExpiresAt if: status == pending OR status == expired
- Absolute time and slot at which the pending transaction TTL will expire. + Absolute time and slot at which the pending transaction TTL (time to live) will lapse. <<: *slotReference x-transactionPendingSince: &transactionPendingSince @@ -741,6 +741,29 @@ x-transactionMetadata: &transactionMetadata 3: { "list": [ { "int": 14 }, { "int": 42 }, { "string": "1337" } ] } 4: { "map": [{ "k": { "string": "key" }, "v": { "string": "value" }}, { "k": { "int": 14 }, "v": { "int": 42 } }] } +x-transactionTTL: &transactionTTL + description: | + The TTL (time to live) is the time period in which the transaction + will be accepted into node mempools. + + After the TTL has lapsed, the transaction is considered + expired. At this point, nodes will give up on broadcasting the + transaction, and the wallet will release the funds allocated to + the transaction so they can be used for other payments. + + The TTL should be long enough that the transaction has time to be + propagated through the network and confirmed, but short enough so + that - in the event of failures - UTxO are returned to the wallet + in a timely manner. + + The TTL value is given in seconds. It will be converted to a slot + number internally. + + If the TTL is not provided for a payment, a reasonable default + value will be used. + + <<: *numberOfSeconds + x-stakePoolApparentPerformance: &stakePoolApparentPerformance description: | Apparent performance of the stake pool over past epochs. This indicator is computed @@ -1614,6 +1637,7 @@ components: payments: *transactionOutputs withdrawal: *transactionWithdrawalRequestSelf metadata: *transactionMetadata + time_to_live: *transactionTTL ApiPostRedemptionData: &ApiPostRedemptionData type: object @@ -1643,6 +1667,7 @@ components: payments: *transactionOutputs withdrawal: *transactionWithdrawalRequestSelf metadata: *transactionMetadata + time_to_live: *transactionTTL ApiPostRedemptionFeeData: &ApiPostRedemptionFeeData type: object