remove unused parameter of addTxSubmission

lib/wallet/src/Cardano/Wallet.hs

@@ -1938,7 +1938,7 @@ buildSignSubmitTransaction ti db@DBLayer{..} netLayer txLayer pwd walletId
                             )
                         )
 
-            addTxSubmission walletId (builtTx, builtTxMeta, builtSealedTx) slot
+            addTxSubmission walletId (builtTxMeta, builtSealedTx) slot
                 & throwWrappedErr wrapNoWalletForSubmit
 
             postTx netLayer builtSealedTx
@@ -2313,7 +2313,7 @@ submitTx tr DBLayer{..} nw walletId tx@BuiltTx{..} =
         withExceptT ErrSubmitTxNoSuchWallet $
             mapExceptT atomically $
                 addTxSubmission walletId
-                    (builtTx, builtTxMeta, builtSealedTx)
+                    (builtTxMeta, builtSealedTx)
                     (builtTxMeta ^. #slotNo)
 
 -- | Broadcast an externally-signed transaction to the network.

lib/wallet/src/Cardano/Wallet/DB.hs

@@ -329,7 +329,7 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
 
     , addTxSubmission
         :: WalletId
-        -> (Tx, TxMeta, SealedTx)
+        -> (TxMeta, SealedTx)
         -> SlotNo
         -> ExceptT ErrNoSuchWallet stm ()
         -- ^ Add a /new/ transaction to the local submission pool
@@ -768,7 +768,7 @@ data DBPendingTxs stm = DBPendingTxs
 
     , addTxSubmission_
         :: WalletId
-        -> (Tx, TxMeta, SealedTx)
+        -> (TxMeta, SealedTx)
         -> SlotNo
         -> stm ()
         -- ^ Add a /new/ transaction to the local submission pool

lib/wallet/src/Cardano/Wallet/DB/Store/Submissions/Layer.hs

@@ -99,7 +99,7 @@ mkDbPendingTxs dbvar = DBPendingTxs
                             $ error "pls pass meta to putLocalTxSubmission!"
                     in  (delta, Right ())
 
-    , addTxSubmission_ =  \wid (_ , meta, sealed) resubmitted -> do
+    , addTxSubmission_ =  \wid (meta, sealed) resubmitted -> do
         let (expiry, txId) = extractPendingData sealed
         updateDBVar dbvar
             $ Adjust wid

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

@@ -116,13 +116,11 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
     ( genTokenQuantityPositive )
 import Cardano.Wallet.Primitive.Types.Tx
     ( Direction (..)
-    , LocalTxSubmissionStatus (..)
     , SealedTx (..)
     , TransactionInfo (..)
     , Tx (..)
     , TxMeta (..)
     , TxStatus (..)
-    , isPending
     , mockSealedTx
     )
 import Cardano.Wallet.Primitive.Types.Tx.Constraints
@@ -149,6 +147,8 @@ import Cardano.Wallet.Util
     ( HasCallStack )
 import Control.DeepSeq
     ( NFData (..) )
+import Control.Lens
+    ( _2 )
 import Control.Monad
     ( forM_, replicateM, void )
 import Control.Monad.Class.MonadTime
@@ -183,10 +183,8 @@ import Data.Coerce
     ( coerce )
 import Data.Either
     ( isLeft, isRight )
-import Data.Function
-    ( on )
 import Data.Generics.Internal.VL
-    ( iso, set, view, (^.) )
+    ( iso, view, (^.), set )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Map.Strict
@@ -236,13 +234,12 @@ import Test.QuickCheck
     , oneof
     , property
     , scale
-    , shrinkList
     , sized
     , suchThat
     , vector
     , withMaxSuccess
     , (===)
-    , (==>)
+    , (==>), Arbitrary2 (..), shrinkList, listOf
     )
 import Test.QuickCheck.Extra
     ( report )
@@ -644,8 +641,7 @@ prop_estimateFee (NonEmpty coins) =
 -------------------------------------------------------------------------------}
 
 data TxRetryTest = TxRetryTest
-    { retryTestPool :: [LocalTxSubmissionStatus SealedTx]
-    , retryTestTxHistory :: GenTxHistory
+    { retryTestPool :: [(TxMeta, SealedTx, SlotNo)]
     , postTxResults :: [(SealedTx, Bool)]
     , testSlottingParameters :: SlottingParameters
     , retryTestWallet :: (WalletId, WalletName, DummyState)
@@ -654,74 +650,55 @@ data TxRetryTest = TxRetryTest
 numSlots :: TxRetryTest -> Word64
 numSlots = const 100
 
-newtype GenTxHistory = GenTxHistory { getTxHistory :: [(Tx, TxMeta)] }
+type TxCore = (Hash "Tx", TxMeta)
+newtype GenSubmissions = GenSubmissions { genSubmissions :: [TxCore] }
     deriving (Generic, Show, Eq)
 
-instance Arbitrary GenTxHistory where
-    arbitrary = fmap GenTxHistory (gen `suchThat` hasPending)
+instance Arbitrary GenSubmissions where
+    arbitrary = fmap GenSubmissions $ listOf genTxMeta
       where
-        gen = uniq <$> listOf1 ((,) <$> genTx' <*> genTxMeta)
-        uniq = L.nubBy ((==) `on` (view #txId . fst))
-        genTx' = mkTx <$> genTid
-        hasPending = any ((== Pending) . view #status . snd)
-        genTid = Hash . B8.pack <$> listOf1 (elements ['A'..'Z'])
-        mkTx txId = Tx
-            { txId
-            , txCBOR = Nothing
-            , fee = Nothing
-            , resolvedInputs = []
-            , resolvedCollateralInputs = []
-            , outputs = []
-            , collateralOutput = Nothing
-            , withdrawals = mempty
-            , metadata = Nothing
-            , scriptValidity = Nothing
-            }
         genTxMeta = do
             sl <- genSmallSlot
             let bh = Quantity $ fromIntegral $ unSlotNo sl
-            st <- elements [Pending, InLedger, Expired]
-            dir <- elements [Incoming, Outgoing]
+            st <- elements [Pending]
+            dir <- elements [Outgoing]
             expry <- oneof [fmap (Just . (+ sl)) genSmallSlot, pure Nothing]
-            pure $ TxMeta st dir sl bh (Coin 0) expry
+            i <- arbitrary
+            pure $ (i, TxMeta st dir sl bh (Coin 0) expry)
         genSmallSlot = SlotNo . fromIntegral <$> sized (\n -> choose (0, 4 * n))
 
-    shrink = fmap GenTxHistory
+    shrink = fmap GenSubmissions
         . filter (not . null)
-        . shrinkList (liftShrink2 shrinkTx' shrinkMeta)
-        . getTxHistory
+        . shrinkList (liftShrink2 shrink shrinkMeta)
+        . genSubmissions
       where
-        shrinkTx' tx = [set #txId tid' tx | tid' <- shrink (view #txId tx)]
         shrinkMeta (TxMeta st dir sl bh amt ex) =
             [ TxMeta st dir sl' bh amt ex'
             | (sl', ex') <- liftShrink2 shrinkSlotNo (liftShrink shrinkSlotNo)
                 (sl, ex) ]
 
 instance Arbitrary TxRetryTest where
     arbitrary = do
-        txHistory <- arbitrary
-        let pool = mkLocalTxSubmissionStatus txHistory
-        results <- zip (map (view #submittedTx) pool) . getInfiniteList <$> arbitrary
-        TxRetryTest pool txHistory results <$> arbitrary <*> arbitrary
+        metas <- arbitrary
+        let pool = mkLocalTxSubmissionStatus metas
+        results <- zip (map (view _2) pool) . getInfiniteList <$> arbitrary
+        TxRetryTest pool results <$> arbitrary <*> arbitrary
 
-    shrink (TxRetryTest _ txHistory res sp wal) =
-        [ TxRetryTest (mkLocalTxSubmissionStatus txHistory') txHistory' res sp' wal'
+    shrink (TxRetryTest txHistory res sp wal) =
+        [ TxRetryTest txHistory' res sp' wal'
         | (txHistory', sp', wal') <- shrink (txHistory, sp, wal)
         ]
 
 mkLocalTxSubmissionStatus
-    :: GenTxHistory
-    -> [LocalTxSubmissionStatus SealedTx]
-mkLocalTxSubmissionStatus = mapMaybe getStatus . getTxHistory
+    :: GenSubmissions
+    -> [(TxMeta, SealedTx, SlotNo)]
+mkLocalTxSubmissionStatus = mapMaybe getStatus . genSubmissions
   where
-    getStatus :: (Tx, TxMeta) -> Maybe (LocalTxSubmissionStatus SealedTx)
-    getStatus (tx, txMeta)
-        | isPending txMeta = Just st
-        | otherwise = Nothing
+    getStatus :: (Hash "Tx", TxMeta) -> Maybe (TxMeta, SealedTx, SlotNo)
+    getStatus (i,txMeta) =  Just st
       where
-        i = tx ^. #txId
         sl = txMeta ^. #slotNo
-        st = LocalTxSubmissionStatus i (fakeSealedTx (tx, [])) sl
+        st = (txMeta, fakeSealedTx (i, []), sl)
 
 instance Arbitrary SlottingParameters where
     arbitrary = mk <$> choose (0.5, 1)
@@ -773,13 +750,11 @@ prop_localTxSubmission :: TxRetryTest -> Property
 prop_localTxSubmission tc = monadicIO $ do
     st <- TxRetryTestState tc 2 <$> newMVar (Time 0)
     res <- run $ runTest st $ \ctx@(TxRetryTestCtx DBLayer{..} _ _ wid) -> do
-        -- Test setup
-        atomically $ do
-            let txHistory = getTxHistory (retryTestTxHistory tc)
-            unsafeRunExceptT $ putTxHistory wid txHistory
-            forM_ (retryTestPool tc) $ \(LocalTxSubmissionStatus i tx sl) ->
-                unsafeRunExceptT $ putLocalTxSubmission wid i tx sl
 
+        atomically
+            $ unsafeRunExceptT
+            $ forM_ (retryTestPool tc) $ \(meta, sealed, sl) ->
+                addTxSubmission wid (meta,sealed) sl
         -- Run test
         let cfg = LocalTxSubmissionConfig (timeStep st) 10
         runLocalTxSubmissionPool @_ @DummyState @ShelleyKey cfg ctx wid
@@ -795,16 +770,9 @@ prop_localTxSubmission tc = monadicIO $ do
 
     -- props:
     --  1. pending transactions in pool are retried
-    let inPool = (`elem` (submittedTx <$> retryTestPool tc))
+    let inPool x = x `elem` (view _2 <$> retryTestPool tc)
     assert (all inPool (resSubmittedTxs res))
 
-    --  2. non-pending transactions not retried
-    let nonPending = map (view #txId . fst)
-            . filter ((/= Pending) . view #status . snd)
-            . getTxHistory $ retryTestTxHistory tc
-    assert (all (`notElem` (map fakeSealedTxId $ resSubmittedTxs res)) nonPending)
-
-    --  3. retries can fail and not break the wallet
     assert (not $ null $ resAction res)
 
   where
@@ -1209,7 +1177,7 @@ dummyTransactionLayer = TransactionLayer
                 return $ xpubToBytes (getKey $ publicKey xprv) <> sig
 
         -- (tx1, wit1) == (tx2, wit2) <==> fakebinary1 == fakebinary2
-        let fakeBinary = fakeSealedTx (tx, wit)
+        let fakeBinary = fakeSealedTx (tx ^. #txId, wit)
         return (tx, fakeBinary)
 
     , addVkWitnesses =
@@ -1263,10 +1231,10 @@ dummyTransactionLayer = TransactionLayer
     forMaybe :: [a] -> (a -> Maybe b) -> [b]
     forMaybe = flip mapMaybe
 
-fakeSealedTx :: HasCallStack => (Tx, [ByteString]) -> SealedTx
+fakeSealedTx :: HasCallStack => (Hash "Tx", [ByteString]) -> SealedTx
 fakeSealedTx (tx, wit) = mockSealedTx $ B8.pack repr
   where
-    repr = show (view #txId tx, wit)
+    repr = show (tx, wit)
 
 fakeSealedTxId :: SealedTx -> Hash "Tx"
 fakeSealedTxId = fst . parse . B8.unpack . serialisedTx