Add transaction expiry slot for pending transactions

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -49,6 +49,10 @@ module Test.Integration.Framework.DSL
     -- * Lens
     , walletId
 
+    -- * Constants
+    , minUTxOValue
+    , defaultTxTTL
+
     -- * Helpers
     , (</>)
     , (!!)
@@ -110,7 +114,6 @@ module Test.Integration.Framework.DSL
     , rootPrvKeyFromMnemonics
     , unsafeGetTransactionTime
     , getTxId
-    , minUTxOValue
 
     -- * Delegation helpers
     , mkEpochInfo
@@ -160,6 +163,7 @@ import Cardano.Mnemonic
 import Cardano.Wallet.Api.Types
     ( AddressAmount
     , ApiAddress
+    , ApiBlockReference (..)
     , ApiByronWallet
     , ApiCoinSelection
     , ApiEpochInfo (ApiEpochInfo)
@@ -180,7 +184,6 @@ import Cardano.Wallet.Api.Types
     , Iso8601Time (..)
     , WalletStyle (..)
     , insertedAt
-    , time
     )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( AccountingStyle (..)
@@ -215,6 +218,7 @@ import Cardano.Wallet.Primitive.Types
     , HistogramBar (..)
     , PoolId (..)
     , SlotLength (..)
+    , SlotNo (..)
     , SortOrder (..)
     , TxIn (..)
     , TxOut (..)
@@ -522,11 +526,20 @@ walletId =
     _set (s, v) = set typed (ApiT $ WalletId (unsafeCreateDigest v)) s
 
 --
--- Helpers
+-- Constants
 --
+
+-- | Min UTxO parameter for the test cluster.
 minUTxOValue :: Natural
 minUTxOValue = 1_000_000
 
+-- | Wallet server's chosen transaction TTL value (in slots) when none is given.
+defaultTxTTL :: SlotNo
+defaultTxTTL = 7200
+
+--
+-- Helpers
+--
 data MnemonicLength = M9 | M12 | M15 | M18 | M21 | M24 deriving (Show)
 
 genMnemonics :: MnemonicLength -> IO [Text]
@@ -574,10 +587,10 @@ waitForNextEpoch
     :: Context t
     -> IO ()
 waitForNextEpoch ctx = do
-    epoch <- getFromResponse (#nodeTip . #epochNumber) <$>
+    epoch <- getFromResponse (#nodeTip . #slotId . #epochNumber) <$>
         request @ApiNetworkInformation ctx Link.getNetworkInfo Default Empty
     eventually "waitForNextEpoch: goes to next epoch" $ do
-        epoch' <- getFromResponse (#nodeTip . #epochNumber) <$>
+        epoch' <- getFromResponse (#nodeTip . #slotId . #epochNumber) <$>
             request @ApiNetworkInformation ctx Link.getNetworkInfo Default Empty
         unless (getApiT epoch' > getApiT epoch) $ fail "not yet"
 
@@ -1788,7 +1801,7 @@ getSlotParams ctx = do
     r1 <- request @ApiNetworkInformation ctx
           Link.getNetworkInfo Default Empty
     let ApiT currentEpoch =
-             view #epochNumber
+             view (#slotId . #epochNumber)
             $ fromMaybe (error "getSlotParams: tip is Nothing")
             $ getFromResponse #networkTip r1
 

lib/core-integration/src/Test/Integration/Scenario/API/Network.hs

@@ -17,7 +17,6 @@ import Cardano.Wallet.Api.Types
     , NtpSyncingStatus (..)
     , WalletStyle (..)
     , epochStartTime
-    , getApiT
     , nextEpoch
     )
 import Cardano.Wallet.Primitive.SyncProgress
@@ -28,8 +27,6 @@ import Control.Monad.IO.Class
     ( liftIO )
 import Data.Generics.Internal.VL.Lens
     ( view, (^.) )
-import Data.Maybe
-    ( fromJust )
 import Data.Time.Clock
     ( getCurrentTime )
 import Test.Hspec
@@ -70,9 +67,10 @@ spec = describe "COMMON_NETWORK" $ do
                 , expectField (#nodeTip . #absoluteSlotNumber . #getApiT) (`shouldNotBe` 0)
                 ]
 
-            let Just currentEpochNum = getApiT . (view #epochNumber) <$> (i ^. #networkTip)
-            let nextEpochNum = view (#epochNumber . #getApiT)
-                    $ fromJust $ getFromResponse #nextEpoch r
+            let Just currentEpochNum =
+                    view (#slotId . #epochNumber . #getApiT) <$> (i ^. #networkTip)
+            let Just nextEpochNum =
+                    view (#epochNumber . #getApiT) <$> getFromResponse #nextEpoch r
             nextEpochNum `shouldBe` currentEpochNum + 1
 
     it "NETWORK_BYRON - Byron wallet has the same tip as network/information" $
@@ -85,21 +83,21 @@ spec = describe "COMMON_NETWORK" $ do
                 expectField (#syncProgress . #getApiT) (`shouldBe` Ready) sync
 
                 let epochNum =
-                        getFromResponse (#nodeTip . #epochNumber . #getApiT) sync
+                        getFromResponse (#nodeTip . #slotId . #epochNumber . #getApiT) sync
                 let slotNum =
-                        getFromResponse (#nodeTip . #slotNumber . #getApiT) sync
+                        getFromResponse (#nodeTip . #slotId . #slotNumber . #getApiT) sync
                 let blockHeight =
-                        getFromResponse (#nodeTip . #height) sync
+                        getFromResponse (#nodeTip . #block . #height) sync
                 let absSlot =
                         getFromResponse (#nodeTip . #absoluteSlotNumber) sync
 
                 res <- request @ApiByronWallet ctx
                     (Link.getWallet @'Byron w) Default Empty
                 verify res
                     [ expectField (#state . #getApiT) (`shouldBe` Ready)
-                    , expectField (#tip . #epochNumber . #getApiT) (`shouldBe` epochNum)
-                    , expectField (#tip . #slotNumber  . #getApiT) (`shouldBe` slotNum)
-                    , expectField (#tip . #height) (`shouldBe` blockHeight)
+                    , expectField (#tip . #slotId . #epochNumber . #getApiT) (`shouldBe` epochNum)
+                    , expectField (#tip . #slotId . #slotNumber  . #getApiT) (`shouldBe` slotNum)
+                    , expectField (#tip . #block . #height) (`shouldBe` blockHeight)
                     , expectField (#tip . #absoluteSlotNumber) (`shouldBe` absSlot)
                     ]
 

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs

@@ -34,7 +34,6 @@ import Cardano.Wallet.Api.Types
     , WalletStyle (..)
     , insertedAt
     , pendingSince
-    , time
     )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( PaymentAddress )
@@ -94,6 +93,7 @@ import Test.Integration.Framework.DSL
     , Headers (..)
     , Payload (..)
     , between
+    , defaultTxTTL
     , emptyByronWalletWith
     , emptyRandomWallet
     , emptyWallet
@@ -593,6 +593,35 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
                 (#balance . #available)
                 (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2
 
+    it "TRANS_CREATE_10 - Pending transaction expiry" $ \ctx -> do
+        (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
+        let amt = minUTxOValue :: Natural
+
+        payload <- mkTxPayload ctx wb amt fixturePassphrase
+
+        r <- request @(ApiTransaction n) ctx
+            (Link.createTransaction @'Shelley wa) Default payload
+
+        verify r
+            [ expectSuccess
+            , expectResponseCode HTTP.status202
+            , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
+            , expectField (#status . #getApiT) (`shouldBe` Pending)
+            , expectField #expiresAt (`shouldSatisfy` isJust)
+            ]
+
+        -- This stuff would be easier with Control.Lens...
+
+        -- Get insertion slot and out of response.
+        let (_, Right apiTx) = r
+        let Just sl = view (#absoluteSlotNumber . #getApiT) <$> apiTx ^. #pendingSince
+
+        -- The expected expiry slot (adds the hardcoded default ttl)
+        let ttl = sl + defaultTxTTL
+
+        (view #absoluteSlotNumber <$> (apiTx ^. #expiresAt))
+            `shouldBe` Just (ApiT ttl)
+
     it "TRANSMETA_CREATE_01 - Transaction with metadata" $ \ctx -> do
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
         let amt = (minUTxOValue :: Natural)
@@ -1520,7 +1549,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
                 , replicate 10 (2 * minUTxOValue)
                 ]
         txs <- listAllTransactions @n ctx w
-        let [Just t2, Just t1] = fmap (fmap time . insertedAt) txs
+        let [Just t2, Just t1] = fmap (fmap (view #time) . insertedAt) txs
         let matrix :: [TestCase [ApiTransaction n]] =
                 [ TestCase -- 1
                     { query = toQueryString
@@ -2538,7 +2567,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
         :: [ApiTransaction n]
         -> UTCTime
     unsafeGetTransactionTime txs =
-        case fmap time . insertedAt <$> txs of
+        case fmap (view #time) . insertedAt <$> txs of
             (Just t):_ -> t
             _ -> error "Expected at least one transaction with a time."
 

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs

@@ -1249,17 +1249,17 @@ spec = describe "SHELLEY_WALLETS" $ do
                 expectField (#syncProgress . #getApiT) (`shouldBe` Ready) sync
 
                 let epochNum =
-                        getFromResponse (#nodeTip . #epochNumber . #getApiT) sync
+                        getFromResponse (#nodeTip . #slotId . #epochNumber . #getApiT) sync
                 let slotNum =
-                        getFromResponse (#nodeTip . #slotNumber . #getApiT) sync
+                        getFromResponse (#nodeTip . #slotId . #slotNumber . #getApiT) sync
                 let blockHeight =
-                        getFromResponse (#nodeTip . #height) sync
+                        getFromResponse (#nodeTip . #block . #height) sync
 
                 res <- request @ApiWallet ctx
                     (Link.getWallet @'Shelley w) Default Empty
                 verify res
                     [ expectField (#state . #getApiT) (`shouldBe` Ready)
-                    , expectField (#tip . #epochNumber . #getApiT) (`shouldBe` epochNum)
-                    , expectField (#tip . #slotNumber  . #getApiT) (`shouldBe` slotNum)
-                    , expectField (#tip . #height) (`shouldBe` blockHeight)
+                    , expectField (#tip . #slotId . #epochNumber . #getApiT) (`shouldBe` epochNum)
+                    , expectField (#tip . #slotId . #slotNumber  . #getApiT) (`shouldBe` slotNum)
+                    , expectField (#tip . #block . #height) (`shouldBe` blockHeight)
                     ]

lib/core-integration/src/Test/Integration/Scenario/CLI/Network.hs

@@ -109,4 +109,4 @@ spec = describe "COMMON_CLI_NETWORK" $ do
 
       currentEpochNo :: ApiNetworkInformation -> EpochNo
       currentEpochNo netInfo =
-          (fromJust (netInfo ^. #networkTip)) ^. #epochNumber . #getApiT
+          (fromJust (netInfo ^. #networkTip)) ^. #slotId . #epochNumber . #getApiT

lib/core/src/Cardano/Wallet.hs

@@ -840,6 +840,7 @@ 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
     forM_ slotPoolDelegations $ \delegation@(slotNo, cert) -> do
         liftIO $ logDelegation delegation
@@ -1595,10 +1596,10 @@ signPayment ctx wid argGenChange mkRewardAccount pwd md cs = db & \DBLayer{..} -
 
             let keyFrom = isOwned (getState cp) (xprv, pwdP)
             let rewardAcnt = mkRewardAccount (xprv, pwdP)
-            (tx, sealedTx) <- withExceptT ErrSignPaymentMkTx $ ExceptT $ pure $
-                mkStdTx tl rewardAcnt keyFrom (nodeTip ^. #slotNo) md cs'
+            (tx, sealedTx, txExp) <- withExceptT ErrSignPaymentMkTx $ ExceptT $
+                pure $ mkStdTx tl rewardAcnt keyFrom (nodeTip ^. #slotNo) md cs'
 
-            (time, meta) <- liftIO $ mkTxMeta ti (currentTip cp) s' tx cs'
+            (time, meta) <- liftIO $ mkTxMeta ti (currentTip cp) s' tx cs' txExp
             return (tx, meta, time, sealedTx)
   where
     ti :: TimeInterpreter IO
@@ -1636,10 +1637,11 @@ signTx ctx wid pwd md (UnsignedTx inpsNE outsNE) = db & \DBLayer{..} -> do
             let cs = mempty { inputs = inps, outputs = outs }
             let keyFrom = isOwned (getState cp) (xprv, pwdP)
             let rewardAcnt = getRawKey $ deriveRewardAccount @k pwdP xprv
-            (tx, sealedTx) <- withExceptT ErrSignPaymentMkTx $ ExceptT $ pure $
-                mkStdTx tl (rewardAcnt, pwdP) keyFrom (nodeTip ^. #slotNo) md cs
+            (tx, sealedTx, txExp) <- withExceptT ErrSignPaymentMkTx $ ExceptT $
+                pure $ mkStdTx tl (rewardAcnt, pwdP) keyFrom (nodeTip ^. #slotNo) md cs
 
-            (time, meta) <- liftIO $ mkTxMeta ti (currentTip cp) (getState cp) tx cs
+            (time, meta) <- liftIO $
+                mkTxMeta ti (currentTip cp) (getState cp) tx cs txExp
             return (tx, meta, time, sealedTx)
   where
     ti :: TimeInterpreter IO
@@ -1729,7 +1731,7 @@ 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) <- withExceptT ErrSignDelegationMkTx $ ExceptT $ pure $
+            (tx, sealedTx, txExp) <- withExceptT ErrSignDelegationMkTx $ ExceptT $ pure $
                 case action of
                     RegisterKeyAndJoin poolId ->
                         mkDelegationJoinTx tl poolId
@@ -1753,7 +1755,7 @@ signDelegation ctx wid argGenChange pwd coinSel action = db & \DBLayer{..} -> do
                             coinSel'
 
             (time, meta) <- liftIO $
-                mkTxMeta ti (currentTip cp) s' tx coinSel'
+                mkTxMeta ti (currentTip cp) s' tx coinSel' txExp
             return (tx, meta, time, sealedTx)
   where
     ti :: TimeInterpreter IO
@@ -1762,8 +1764,8 @@ signDelegation ctx wid argGenChange pwd coinSel action = db & \DBLayer{..} -> do
     tl = ctx ^. transactionLayer @t @k
     nl = ctx ^. networkLayer @t
 
--- | Construct transaction metadata from a current block header and a list
--- of input and output.
+-- | Construct transaction metadata for a pending transaction from the block
+-- header of the current tip and a list of input and output.
 --
 -- FIXME: There's a logic duplication regarding the calculation of the transaction
 -- amount between right here, and the Primitive.Model (see prefilterBlocks).
@@ -1774,8 +1776,9 @@ mkTxMeta
     -> s
     -> Tx
     -> CoinSelection
+    -> SlotNo
     -> m (UTCTime, TxMeta)
-mkTxMeta interpretTime blockHeader wState tx cs =
+mkTxMeta interpretTime blockHeader wState tx cs expiry =
     let
         amtOuts =
             sum (mapMaybe ourCoins (outputs cs))
@@ -1794,6 +1797,7 @@ mkTxMeta interpretTime blockHeader wState tx cs =
                 , slotNo = blockHeader ^. #slotNo
                 , blockHeight = blockHeader ^. #blockHeight
                 , amount = Quantity $ distance amtInps amtOuts
+                , expiry = Just expiry
                 }
             )
   where
@@ -1848,7 +1852,8 @@ submitExternalTx ctx bytes = do
     nw = ctx ^. networkLayer @t
     tl = ctx ^. transactionLayer @t @k
 
--- | Forget pending transaction.
+-- | Forget pending transaction. This happens at the request of the user and
+-- will remove the transaction from the history.
 forgetPendingTx
     :: forall ctx s k.
         ( HasDBLayer s k ctx