Add missing tx policies

Author: bolt12

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/TxSubmission/Common.hs

@@ -841,10 +841,10 @@ prop_receivedTxIds_generator (ArbReceivedTxIds _ someTxsToAck _peeraddr _ps st)
 -- by `prop_receivedTxIdsImpl`, `prop_collectTxsImpl` and
 -- `prop_makeDecisions_acknowledged`.
 --
-prop_acknowledgeTxIds :: ArbReceivedTxIds
+prop_acknowledgeTxIds :: ArbDecisionContextWithReceivedTxIds
                       -> Property
-prop_acknowledgeTxIds (ArbReceivedTxIds _mempoolHasTxFun _txs _peeraddr ps st) =
-    case TXS.acknowledgeTxIds undefined st ps of
+prop_acknowledgeTxIds (ArbDecisionContextWithReceivedTxIds policy SharedDecisionContext { sdcSharedTxState = st } ps _ _ _) =
+    case TXS.acknowledgeTxIds policy st ps of
       (numTxIdsToAck, _, txs, TXS.RefCountDiff { TXS.txIdsToAck }, ps') ->
              counterexample "number of tx ids to ack must agree with RefCountDiff"
              ( fromIntegral numTxIdsToAck
@@ -877,12 +877,13 @@ prop_acknowledgeTxIds (ArbReceivedTxIds _mempoolHasTxFun _txs _peeraddr ps st) =
 
 -- | Verify that `hasTxIdsToAcknowledge` and `acknowledgeTxIds` are compatible.
 --
+--
 prop_hasTxIdsToAcknowledge
-  :: ArbReceivedTxIds
+  :: ArbDecisionContextWithReceivedTxIds
   -> Property
-prop_hasTxIdsToAcknowledge (ArbReceivedTxIds _mempoolHasTxFun _txs _peeraddr ps st) =
+prop_hasTxIdsToAcknowledge (ArbDecisionContextWithReceivedTxIds policy SharedDecisionContext { sdcSharedTxState = st } ps _ _ _) =
     case ( TXS.hasTxIdsToAcknowledge st ps
-         , TXS.acknowledgeTxIds undefined st ps
+         , TXS.acknowledgeTxIds policy st ps
          ) of
       (canAck, (numTxIdsToAck, _, _, _, _)) ->
         canAck === (numTxIdsToAck > 0)
@@ -1612,7 +1613,7 @@ prop_makeDecisions_acknowledged
 
         ackFromState :: Map PeerAddr NumTxIdsToAck
         ackFromState =
-            Map.map (\ps -> case TXS.acknowledgeTxIds undefined sharedTxState ps of
+            Map.map (\ps -> case TXS.acknowledgeTxIds policy sharedTxState ps of
                               (a, _, _, _, _) -> a)
           . peerTxStates
           $ sharedTxState
@@ -1666,6 +1667,7 @@ prop_makeDecisions_exhaustive
 data ArbDecisionContextWithReceivedTxIds = ArbDecisionContextWithReceivedTxIds {
       adcrDecisionPolicy :: TxDecisionPolicy,
       adcrSharedContext  :: SharedDecisionContext PeerAddr TxId (Tx TxId),
+      adcrPeerTxState    :: PeerTxState TxId (Tx TxId),
       adcrMempoolHasTx   :: Fun TxId Bool,
       adcrTxsToAck       :: [Tx TxId],
       -- txids to acknowledge
@@ -1681,13 +1683,14 @@ instance Arbitrary ArbDecisionContextWithReceivedTxIds where
       ArbReceivedTxIds mempoolHasTx
                        txIdsToAck
                        peeraddr
-                       _ps
+                       ps
                        st
         <- arbitrary
 
       let st' = fixupSharedTxStateForPolicy
                   (apply mempoolHasTx)
                   policy st
+          ps' = fixupPeerTxStateWithPolicy policy ps
           txIdsToAck' = take (fromIntegral (TXS.requestedTxIdsInflight $ peerTxStates st' Map.! peeraddr)) txIdsToAck
           peers = Map.keys (peerTxStates st')
 
@@ -1700,6 +1703,7 @@ instance Arbitrary ArbDecisionContextWithReceivedTxIds where
               sdcPeerGSV       = Map.fromList gsvs,
               sdcSharedTxState = st'
             },
+          adcrPeerTxState    = ps',
           adcrMempoolHasTx   = mempoolHasTx,
           adcrTxsToAck       = txIdsToAck',
           adcrPeerAddr       = peeraddr
@@ -1708,6 +1712,7 @@ instance Arbitrary ArbDecisionContextWithReceivedTxIds where
     shrink ArbDecisionContextWithReceivedTxIds {
         adcrDecisionPolicy = policy,
         adcrSharedContext  = ctx,
+        adcrPeerTxState    = ps,
         adcrMempoolHasTx   = mempoolHasTx,
         adcrTxsToAck       = txIdsToAck,
         adcrPeerAddr       = peeraddr
@@ -1716,6 +1721,7 @@ instance Arbitrary ArbDecisionContextWithReceivedTxIds where
       [ ArbDecisionContextWithReceivedTxIds {
           adcrDecisionPolicy = policy',
           adcrSharedContext  = ctx',
+          adcrPeerTxState    = ps,
           adcrMempoolHasTx   = mempoolHasTx',
           adcrTxsToAck       = txIdsToAck',
           adcrPeerAddr       = peeraddr