module Test.Ouroboros.Network.TxSubmission.MempoolWriter (tests) where

import Control.Concurrent.Class.MonadSTM (newTVarIO, readTVarIO)
import Control.Monad.IOSim (runSimOrThrow)

import Ouroboros.Network.Protocol.TxSubmission2.Type (SizeInBytes (..))
import Ouroboros.Network.TxSubmission.Inbound.V1
           (TxSubmissionMempoolWriter (..))

import Test.Ouroboros.Network.TxSubmission.Types

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCaseSteps, (@?=))


tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"MempoolWriter"
  [ TestName -> ((TestName -> IO ()) -> IO ()) -> TestTree
testCaseSteps TestName
"getMempoolWriter records only valid duplicates" (TestName -> IO ()) -> IO ()
unit_getMempoolWriter_recordsOnlyValidDuplicates
  ]


unit_getMempoolWriter_recordsOnlyValidDuplicates :: (String -> IO ()) -> IO ()
unit_getMempoolWriter_recordsOnlyValidDuplicates :: (TestName -> IO ()) -> IO ()
unit_getMempoolWriter_recordsOnlyValidDuplicates TestName -> IO ()
step = do
  TestName -> IO ()
step TestName
"Populate the inbound mempool with one valid tx and submit one invalid duplicate plus one valid duplicate"
  let ([TxId]
accepted, [(TxId, InvalidTx)]
rejected, [TxId]
duplicateTxIds) =
        (forall s. IOSim s ([TxId], [(TxId, InvalidTx)], [TxId]))
-> ([TxId], [(TxId, InvalidTx)], [TxId])
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s ([TxId], [(TxId, InvalidTx)], [TxId]))
 -> ([TxId], [(TxId, InvalidTx)], [TxId]))
-> (forall s. IOSim s ([TxId], [(TxId, InvalidTx)], [TxId]))
-> ([TxId], [(TxId, InvalidTx)], [TxId])
forall a b. (a -> b) -> a -> b
$ do
          duplicateVar <- [TxId] -> IOSim s (TVar (IOSim s) [TxId])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []
          mempool <- newMempool [mkTx 17 True]
          let writer = TVar (IOSim s) [TxId]
-> Mempool (IOSim s) TxId (Tx TxId)
-> TxSubmissionMempoolWriter
     TxId (Tx TxId) Integer (IOSim s) InvalidTx
forall txid (m :: * -> *).
(MonadSTM m, MonadTime m, MonadThrow m, Ord txid, Eq txid,
 Typeable txid, Show txid) =>
TVar m [txid]
-> Mempool m txid (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
getMempoolWriter TVar (IOSim s) [TxId]
TVar s [TxId]
duplicateVar Mempool (IOSim s) TxId (Tx TxId)
mempool
          result <- mempoolAddTxs writer [mkTx 17 False, mkTx 17 True]
          duplicates <- readTVarIO duplicateVar
          pure (fst result, snd result, duplicates)

  TestName -> IO ()
step TestName
"Assert both submissions are rejected as duplicates but only the valid duplicate is recorded for result accounting"
  [TxId]
accepted [TxId] -> [TxId] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= []
  [(TxId, InvalidTx)]
rejected [(TxId, InvalidTx)] -> [(TxId, InvalidTx)] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [(TxId
17, InvalidTx
DuplicateTx), (TxId
17, InvalidTx
DuplicateTx)]
  [TxId]
duplicateTxIds [TxId] -> [TxId] -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
@?= [TxId
17]
  where
    mkTx :: TxId -> Bool -> Tx TxId
    mkTx :: TxId -> Bool -> Tx TxId
mkTx TxId
txid Bool
isValid =
      Tx {
          getTxId :: TxId
getTxId = TxId
txid,
          getTxSize :: SizeInBytes
getTxSize = Word32 -> SizeInBytes
SizeInBytes Word32
1,
          getTxAdvSize :: SizeInBytes
getTxAdvSize = Word32 -> SizeInBytes
SizeInBytes Word32
1,
          getTxValid :: Bool
getTxValid = Bool
isValid,
          getTxParent :: Maybe TxId
getTxParent = Maybe TxId
forall a. Maybe a
Nothing
        }