Update tests, etc

lib/core/src/Cardano/Wallet.hs

@@ -828,7 +828,7 @@ restoreBlocks ctx wid blocks nodeTip = db & \DBLayer{..} -> mapExceptT atomicall
     let k = gp ^. #getEpochStability
     let localTip = currentTip $ NE.last cps
 
-    updatePendingTx (PrimaryKey wid) localTip
+    updatePendingTx (PrimaryKey wid) (view #slotNo localTip)
     putTxHistory (PrimaryKey wid) txs
     forM_ slotPoolDelegations $ \delegation@(slotNo, cert) -> do
         liftIO $ logDelegation delegation

lib/core/src/Cardano/Wallet/DB/Model.hs

@@ -262,11 +262,12 @@ mListCheckpoints wid db@(Database wallets _) =
     tips = map currentTip . Map.elems . checkpoints
 
 mUpdatePendingTx :: Ord wid => wid -> SlotNo -> ModelOp wid s xprv ()
-mUpdatePendingTx wid tip = alterModel wid $ \wal ->
+mUpdatePendingTx wid currentTip = alterModel wid $ \wal ->
     ((), wal { txHistory = setExpired <$> txHistory wal })
   where
+    setExpired :: TxMeta -> TxMeta
     setExpired txMeta
-        | expiry txMeta >= Just tip = txMeta { status = Expired }
+        | expiry txMeta >= Just currentTip = txMeta { status = Expired }
         | otherwise = txMeta
 
 mRemovePendingTx :: Ord wid => wid -> (Hash "Tx") -> ModelOp wid s xprv ()

lib/core/test/bench/db/Main.hs

@@ -518,6 +518,7 @@ mkTxHistory numTx numInputs numOutputs range =
             , slotNo = sl i
             , blockHeight = Quantity $ fromIntegral i
             , amount = Quantity (fromIntegral numOutputs)
+            , expiry = Nothing
             }
         )
     | !i <- [1..numTx]

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -719,6 +719,7 @@ spec = do
                     , amount = amount (x :: ApiTransaction ('Testnet 0))
                     , insertedAt = insertedAt (x :: ApiTransaction ('Testnet 0))
                     , pendingSince = pendingSince (x :: ApiTransaction ('Testnet 0))
+                    , expiresAt = expiresAt (x :: ApiTransaction ('Testnet 0))
                     , depth = depth (x :: ApiTransaction ('Testnet 0))
                     , direction = direction (x :: ApiTransaction ('Testnet 0))
                     , inputs = inputs (x :: ApiTransaction ('Testnet 0))
@@ -1273,14 +1274,19 @@ instance Arbitrary (ApiTransaction t) where
         txInsertedAt <- case txStatus of
             (ApiT Pending) -> pure Nothing
             (ApiT InLedger) -> arbitrary
+            (ApiT Expired) -> pure Nothing
         txPendingSince <- case txStatus of
             (ApiT Pending) -> arbitrary
             (ApiT InLedger) -> pure Nothing
+            (ApiT Expired) -> arbitrary
+        let txExpiresAt = txInsertedAt
+
         ApiTransaction
             <$> arbitrary
             <*> arbitrary
             <*> pure txInsertedAt
             <*> pure txPendingSince
+            <*> pure txExpiresAt
             <*> arbitrary
             <*> arbitrary
             <*> genInputs

lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs

@@ -407,6 +407,7 @@ instance Arbitrary TxMeta where
         <*> arbitrary
         <*> fmap Quantity arbitrary
         <*> fmap (Quantity . fromIntegral) (arbitrary @Word32)
+        <*> arbitrary
 
 instance Arbitrary TxStatus where
     arbitrary = elements [Pending, InLedger]

lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs

@@ -856,7 +856,7 @@ testTxs =
         [ (TxIn (mockHash @String "tx1") 0, Coin 1)]
         [ TxOut (Address "addr") (Coin 1) ]
         mempty
-      , TxMeta InLedger Incoming (SlotNo 140) (Quantity 0) (Quantity 1337144)
+      , TxMeta InLedger Incoming (SlotNo 140) (Quantity 0) (Quantity 1337144) Nothing
       )
     ]
 

lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs

@@ -90,6 +90,7 @@ import Cardano.Wallet.DB.Model
     , mRemovePendingTx
     , mRemoveWallet
     , mRollbackTo
+    , mUpdatePendingTx
     )
 import Cardano.Wallet.DummyTarget.Primitive.Types
     ( dummyTimeInterpreter )
@@ -307,6 +308,7 @@ data Cmd s wid
     | ReadProtocolParameters wid
     | RollbackTo wid SlotNo
     | RemovePendingTx wid (Hash "Tx")
+    | UpdatePendingTx wid SlotNo
     | PutDelegationCertificate wid DelegationCertificate SlotNo
     | IsStakeKeyRegistered wid
     | PutDelegationRewardBalance wid (Quantity "lovelace" Word64)
@@ -393,6 +395,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
   where
     timeInterpreter = dummyTimeInterpreter
 
@@ -445,6 +449,8 @@ 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 $
+            mapExceptT atomically $ updatePendingTx (PrimaryKey wid) sl
         PutPrivateKey wid pk -> catchNoSuchWallet Unit $
             mapExceptT atomically $ putPrivateKey (PrimaryKey wid) (fromMockPrivKey pk)
         ReadPrivateKey wid -> Right . PrivateKey . fmap toMockPrivKey <$>
@@ -601,6 +607,7 @@ generator (Model _ wids) = Just $ frequency $ fmap (fmap At) <$> concat
             <*> genRange
             <*> arbitrary)
         , (4, RemovePendingTx <$> genId' <*> arbitrary)
+        , (4, UpdatePendingTx <$> genId' <*> arbitrary)
         , (3, PutPrivateKey <$> genId' <*> genPrivKey)
         , (3, ReadPrivateKey <$> genId')
         , (1, RollbackTo <$> genId' <*> arbitrary)
@@ -744,13 +751,14 @@ instance CommandNames (At (Cmd s)) where
     cmdName (At ReadDelegationRewardBalance{}) = "ReadDelegationRewardBalance"
     cmdName (At RollbackTo{}) = "RollbackTo"
     cmdName (At RemovePendingTx{}) = "RemovePendingTx"
+    cmdName (At UpdatePendingTx{}) = "UpdatePendingTx"
     cmdNames _ =
         [ "CleanDB"
         , "CreateWallet", "RemoveWallet", "ListWallets"
         , "PutCheckpoint", "ReadCheckpoint", "ListCheckpoints", "RollbackTo"
         , "PutWalletMeta", "ReadWalletMeta"
         , "PutDelegationCertificate", "IsStakeKeyRegistered"
-        , "PutTxHistory", "ReadTxHistory", "RemovePendingTx"
+        , "PutTxHistory", "ReadTxHistory", "RemovePendingTx", "UpdatePendingTx"
         , "PutPrivateKey", "ReadPrivateKey"
         , "PutProtocolParameters", "ReadProtocolParameters"
         , "PutDelegationRewardBalance", "ReadDelegationRewardBalance"

lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs

@@ -242,6 +242,7 @@ spec = do
                     , slotNo = SlotNo 1442
                     , blockHeight = Quantity 37
                     , amount = Quantity 1337
+                    , expiry = Just (SlotNo 2442)
                     }
             "-0.001337 pending since 1442#37" === pretty @_ @Text txMeta
         it "TxMeta (2)" $ do
@@ -251,6 +252,7 @@ spec = do
                     , slotNo = SlotNo 140
                     , blockHeight = Quantity 1
                     , amount = Quantity 13371442
+                    , expiry = Nothing
                     }
             "+13.371442 in ledger since 140#1" === pretty @_ @Text txMeta
 

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -162,6 +162,7 @@ import Test.QuickCheck
     , cover
     , elements
     , label
+    , liftArbitrary
     , oneof
     , property
     , scale
@@ -703,7 +704,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 cs -> do
+    { mkStdTx = \_ keyFrom slot cs -> do
         let inps' = map (second coin) (CS.inputs cs)
         let tid = mkTxId inps' (CS.outputs cs) mempty
         let tx = Tx tid inps' (CS.outputs cs) mempty
@@ -716,7 +717,7 @@ dummyTransactionLayer = TransactionLayer
 
         -- (tx1, wit1) == (tx2, wit2) <==> fakebinary1 == fakebinary2
         let fakeBinary = SealedTx . B8.pack $ show (tx, wit)
-        return (tx, fakeBinary)
+        return (tx, fakeBinary, slot + 1)
     , initDelegationSelection =
         error "dummyTransactionLayer: initDelegationSelection not implemented"
     , mkDelegationJoinTx =
@@ -899,8 +900,9 @@ instance Arbitrary TxOut where
 instance Arbitrary TxMeta where
     shrink _ = []
     arbitrary = TxMeta
-        <$> elements [Pending, InLedger]
+        <$> elements [Pending, InLedger, Expired]
         <*> elements [Incoming, Outgoing]
         <*> genSlotNo
         <*> fmap Quantity arbitrary
         <*> fmap (Quantity . fromIntegral) (arbitrary @Word32)
+        <*> liftArbitrary genSlotNo