{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Conway.Imp.BbodySpec (
  spec,
) where

import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosPredFailure)
import Cardano.Ledger.BHeaderView (BHeaderView (..))
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.BaseTypes (BlocksMade (..), Mismatch (..), ProtVer (..), natVersion)
import Cardano.Ledger.Block
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.PParams (ConwayEraPParams (..))
import Cardano.Ledger.Conway.Rules (
  ConwayBbodyPredFailure (..),
  totalRefScriptSizeInBlock,
 )
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Plutus (SLanguage (..), hashPlutusScript)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules (
  BbodyEnv (..),
  Event,
  ShelleyBbodyState (..),
 )
import Cardano.Ledger.Shelley.Scripts (
  pattern RequireSignature,
 )
import Cardano.Ledger.TxIn
import Control.Monad (forM)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import qualified Data.Sequence.Strict as SSeq
import Data.Word (Word32)
import Lens.Micro ((&), (.~), (^.))
import Lens.Micro.Mtl (use)
import Test.Cardano.Ledger.Babbage.ImpTest
import Test.Cardano.Ledger.Core.Utils (txInAt)
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus.Examples (alwaysFailsNoDatum, purposeIsWellformedNoDatum)

spec ::
  forall era.
  ( AlonzoEraImp era
  , BabbageEraTxBody era
  , InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
  , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era
  , ToExpr (Event (EraRule "BBODY" era))
  , ConwayEraPParams era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(AlonzoEraImp era, BabbageEraTxBody era,
 InjectRuleFailure "BBODY" ConwayBbodyPredFailure era,
 InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era,
 ToExpr (Event (EraRule "BBODY" era)), ConwayEraPParams era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = do
  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"BodyRefScriptsSizeTooBig" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    PlutusScript era
plutusScript <- forall era (l :: Language) (m :: * -> *).
(AlonzoEraScript era, PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
mkPlutusScript @era (Plutus 'PlutusV2 -> ImpM (LedgerSpec era) (PlutusScript era))
-> Plutus 'PlutusV2 -> ImpM (LedgerSpec era) (PlutusScript era)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV2 -> Plutus 'PlutusV2
forall (l :: Language). SLanguage l -> Plutus l
purposeIsWellformedNoDatum SLanguage 'PlutusV2
SPlutusV2
    let scriptSize :: Int
scriptSize = PlutusScript era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize PlutusScript era
plutusScript
    PParams era
pp <- Lens' (PParams era) (PParams era) -> ImpTestM era (PParams era)
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (PParams era -> f (PParams era)) -> PParams era -> f (PParams era)
forall a. a -> a
Lens' (PParams era) (PParams era)
id

    -- Determine a number of transactions and a number of times the reference script
    -- needs to be included as an input in each transaction,
    -- in order for the total to exceed the maximum allowed refScript size per block,
    -- while the refScript size per individual transaction doesn't exceed maxRefScriptSizePerTx
    let
      maxRefScriptSizePerTx :: Int
maxRefScriptSizePerTx = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
ppMaxRefScriptSizePerTxG
      maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
ppMaxRefScriptSizePerBlockG
    [Int]
txScriptCounts <-
      Int -> Int -> Int -> ImpTestM era [Int]
forall era. Int -> Int -> Int -> ImpTestM era [Int]
genNumAdditionsExceeding
        Int
scriptSize
        Int
maxRefScriptSizePerTx
        Int
maxRefScriptSizePerBlock

    let mkTxWithNScripts :: Int -> ImpM (LedgerSpec era) (Tx era)
mkTxWithNScripts Int
n = do
          -- Instead of using the rootTxIn, we are creating an input for each transaction
          -- that we subsequently need to submit,
          -- so that we can submit them independently of each other.
          TxIn
txIn <- ImpM (LedgerSpec era) Addr
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m Addr
freshKeyAddr_ ImpM (LedgerSpec era) Addr
-> (Addr -> ImpM (LedgerSpec era) TxIn)
-> ImpM (LedgerSpec era) TxIn
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Addr
addr -> Addr -> Coin -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
Addr -> Coin -> ImpTestM era TxIn
sendCoinTo Addr
addr (Integer -> Coin
Coin Integer
8_000_000)
          [TxIn]
refIns <- Int -> ImpM (LedgerSpec era) TxIn -> ImpM (LedgerSpec era) [TxIn]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (ImpM (LedgerSpec era) TxIn -> ImpM (LedgerSpec era) [TxIn])
-> ImpM (LedgerSpec era) TxIn -> ImpM (LedgerSpec era) [TxIn]
forall a b. (a -> b) -> a -> b
$ Script era -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, BabbageEraTxOut era) =>
Script era -> ImpTestM era TxIn
produceRefScript (PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
plutusScript)
          Tx era -> ImpM (LedgerSpec era) (Tx era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx era -> ImpM (LedgerSpec era) (Tx era))
-> Tx era -> ImpM (LedgerSpec era) (Tx era)
forall a b. (a -> b) -> a -> b
$ TxIn -> NonEmpty TxIn -> Tx era
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> Tx era
mkTxWithRefInputs TxIn
txIn ([TxIn] -> NonEmpty TxIn
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [TxIn]
refIns)

    [Tx era]
txs <- do
      [Int]
-> (Int -> ImpM (LedgerSpec era) (Tx era))
-> ImpM (LedgerSpec era) [Tx era]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
txScriptCounts ((Int -> ImpM (LedgerSpec era) (Tx era))
 -> ImpM (LedgerSpec era) [Tx era])
-> (Int -> ImpM (LedgerSpec era) (Tx era))
-> ImpM (LedgerSpec era) [Tx era]
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
        Int -> ImpM (LedgerSpec era) (Tx era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyEraImp era, BabbageEraTxBody era,
 ToExpr (Event (EraRule "TICK" era)),
 ToExpr (Event (EraRule "LEDGER" era)),
 Eq (Event (EraRule "TICK" era)), Eq (Event (EraRule "LEDGER" era)),
 NFData (Event (EraRule "TICK" era)),
 NFData (Event (EraRule "LEDGER" era)),
 Typeable (Event (EraRule "TICK" era)),
 Typeable (Event (EraRule "LEDGER" era))) =>
Int -> ImpM (LedgerSpec era) (Tx era)
mkTxWithNScripts Int
n
          ImpM (LedgerSpec era) (Tx era)
-> (Tx era -> ImpM (LedgerSpec era) (Tx era))
-> ImpM (LedgerSpec era) (Tx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tx era -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx era -> ImpTestM era (Tx era)
fixupFees
          ImpM (LedgerSpec era) (Tx era)
-> (Tx era -> ImpM (LedgerSpec era) (Tx era))
-> ImpM (LedgerSpec era) (Tx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tx era -> ImpM (LedgerSpec era) (Tx era)
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
updateAddrTxWits

    let expectedTotalRefScriptSize :: Int
expectedTotalRefScriptSize = Int
scriptSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
txScriptCounts
    NonEmpty (PredicateFailure (EraRule "BBODY" era))
predFailures <- Either
  (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
  (ShelleyBbodyState era, [Event (EraRule "BBODY" era)])
-> ImpM
     (LedgerSpec era)
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
forall b (m :: * -> *) a.
(HasCallStack, ToExpr b, MonadIO m) =>
Either a b -> m a
expectLeftExpr (Either
   (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
   (ShelleyBbodyState era, [Event (EraRule "BBODY" era)])
 -> ImpM
      (LedgerSpec era)
      (NonEmpty (PredicateFailure (EraRule "BBODY" era))))
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
        (ShelleyBbodyState era, [Event (EraRule "BBODY" era)]))
-> ImpM
     (LedgerSpec era)
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Tx era]
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
        (State (EraRule "BBODY" era), [Event (EraRule "BBODY" era)]))
tryRunBBODY [Tx era]
txs
    NonEmpty (PredicateFailure (EraRule "BBODY" era))
predFailures
      NonEmpty (PredicateFailure (EraRule "BBODY" era))
-> NonEmpty (PredicateFailure (EraRule "BBODY" era))
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` [PredicateFailure (EraRule "BBODY" era)]
-> NonEmpty (PredicateFailure (EraRule "BBODY" era))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
        [ ConwayBbodyPredFailure era -> EraRuleFailure "BBODY" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
            ( Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
forall era. Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
BodyRefScriptsSizeTooBig (Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era)
-> Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
forall a b. (a -> b) -> a -> b
$
                Mismatch
                  { mismatchSupplied :: Int
mismatchSupplied = Int
expectedTotalRefScriptSize
                  , mismatchExpected :: Int
mismatchExpected = Int
maxRefScriptSizePerBlock
                  }
            )
        ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"BodyRefScriptsSizeTooBig with reference scripts in the same block" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$
    forall (v :: Nat) era.
(EraGov era, KnownNat v, 0 <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersionAtLeast @11 (ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ())
-> ImpM (LedgerSpec era) () -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ do
      Just PlutusScript era
plutusScript <- Maybe (PlutusScript era)
-> ImpM (LedgerSpec era) (Maybe (PlutusScript era))
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PlutusScript era)
 -> ImpM (LedgerSpec era) (Maybe (PlutusScript era)))
-> Maybe (PlutusScript era)
-> ImpM (LedgerSpec era) (Maybe (PlutusScript era))
forall a b. (a -> b) -> a -> b
$ forall era (l :: Language) (m :: * -> *).
(AlonzoEraScript era, PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
mkPlutusScript @era (Plutus 'PlutusV2 -> Maybe (PlutusScript era))
-> Plutus 'PlutusV2 -> Maybe (PlutusScript era)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV2 -> Plutus 'PlutusV2
forall (l :: Language). SLanguage l -> Plutus l
purposeIsWellformedNoDatum SLanguage 'PlutusV2
SPlutusV2
      let scriptSize :: Int
scriptSize = PlutusScript era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize PlutusScript era
plutusScript

      PParams era
pp <- Lens' (PParams era) (PParams era) -> ImpTestM era (PParams era)
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (PParams era -> f (PParams era)) -> PParams era -> f (PParams era)
forall a. a -> a
Lens' (PParams era) (PParams era)
id
      let
        maxRefScriptSizePerTx :: Int
maxRefScriptSizePerTx = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
ppMaxRefScriptSizePerTxG
        maxRefScriptSizePerBlock :: Int
maxRefScriptSizePerBlock = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ PParams era
pp PParams era -> Getting Word32 (PParams era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. Getting Word32 (PParams era) Word32
forall era.
ConwayEraPParams era =>
SimpleGetter (PParams era) Word32
SimpleGetter (PParams era) Word32
ppMaxRefScriptSizePerBlockG
      [Int]
txScriptCounts <-
        Int -> Int -> Int -> ImpTestM era [Int]
forall era. Int -> Int -> Int -> ImpTestM era [Int]
genNumAdditionsExceeding
          Int
scriptSize
          Int
maxRefScriptSizePerTx
          Int
maxRefScriptSizePerBlock

      let expectedTotalRefScriptSize :: Int
expectedTotalRefScriptSize = Int
scriptSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
txScriptCounts

      -- We are creating reference scripts and transaction that depend on them in a "simulation",
      -- so the result will be correctly constructed that are not applied to the ledger state
      [Tx era]
txs :: [Tx era] <- ImpM (LedgerSpec era) [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall era a. ImpTestM era a -> ImpTestM era a
simulateThenRestore (ImpM (LedgerSpec era) [Tx era] -> ImpM (LedgerSpec era) [Tx era])
-> ImpM (LedgerSpec era) [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall a b. (a -> b) -> a -> b
$ do
        [[Tx era]] -> [Tx era]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          ([[Tx era]] -> [Tx era])
-> ImpM (LedgerSpec era) [[Tx era]]
-> ImpM (LedgerSpec era) [Tx era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
-> (Int -> ImpM (LedgerSpec era) [Tx era])
-> ImpM (LedgerSpec era) [[Tx era]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
            [Int]
txScriptCounts
            ( \Int
n -> do
                -- produce reference scripts
                [Tx era]
refScriptTxs <-
                  Int
-> ImpM (LedgerSpec era) (Tx era) -> ImpM (LedgerSpec era) [Tx era]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (NonEmpty (Script era) -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxOut era) =>
NonEmpty (Script era) -> ImpTestM era (Tx era)
produceRefScriptsTx (PlutusScript era -> Script era
forall era. AlonzoEraScript era => PlutusScript era -> Script era
fromPlutusScript PlutusScript era
plutusScript AlonzoScript era
-> [AlonzoScript era] -> NonEmpty (AlonzoScript era)
forall a. a -> [a] -> NonEmpty a
:| []))

                -- spend using the reference scripts
                let txIns :: [TxIn]
txIns = (HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
`mkTxInPartial` Integer
0) (TxId -> TxIn) -> (Tx era -> TxId) -> Tx era -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx (Tx era -> TxIn) -> [Tx era] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx era]
refScriptTxs
                TxIn
rootIn <- (TxIn, TxOut era) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut era) -> TxIn)
-> ImpM (LedgerSpec era) (TxIn, TxOut era)
-> ImpM (LedgerSpec era) TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (TxIn, TxOut era)
forall era. ImpTestM era (TxIn, TxOut era)
getImpRootTxOut
                Tx era
spendTx <- TxIn -> NonEmpty TxIn -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
submitTxWithRefInputs TxIn
rootIn ([TxIn] -> NonEmpty TxIn
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [TxIn]
txIns)
                [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Tx era] -> ImpM (LedgerSpec era) [Tx era])
-> [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall a b. (a -> b) -> a -> b
$ [Tx era]
refScriptTxs [Tx era] -> [Tx era] -> [Tx era]
forall a. [a] -> [a] -> [a]
++ [Item [Tx era]
Tx era
spendTx]
            )

      NonEmpty (PredicateFailure (EraRule "BBODY" era))
predFailures <- Either
  (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
  (ShelleyBbodyState era, [Event (EraRule "BBODY" era)])
-> ImpM
     (LedgerSpec era)
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
forall b (m :: * -> *) a.
(HasCallStack, ToExpr b, MonadIO m) =>
Either a b -> m a
expectLeftExpr (Either
   (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
   (ShelleyBbodyState era, [Event (EraRule "BBODY" era)])
 -> ImpM
      (LedgerSpec era)
      (NonEmpty (PredicateFailure (EraRule "BBODY" era))))
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
        (ShelleyBbodyState era, [Event (EraRule "BBODY" era)]))
-> ImpM
     (LedgerSpec era)
     (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Tx era]
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
        (State (EraRule "BBODY" era), [Event (EraRule "BBODY" era)]))
tryRunBBODY [Tx era]
txs
      NonEmpty (PredicateFailure (EraRule "BBODY" era))
predFailures
        NonEmpty (PredicateFailure (EraRule "BBODY" era))
-> NonEmpty (PredicateFailure (EraRule "BBODY" era))
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
a -> a -> m ()
`shouldBe` [PredicateFailure (EraRule "BBODY" era)]
-> NonEmpty (PredicateFailure (EraRule "BBODY" era))
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList
          [ ConwayBbodyPredFailure era -> EraRuleFailure "BBODY" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure
              ( Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
forall era. Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
BodyRefScriptsSizeTooBig (Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era)
-> Mismatch 'RelLTEQ Int -> ConwayBbodyPredFailure era
forall a b. (a -> b) -> a -> b
$
                  Mismatch
                    { mismatchSupplied :: Int
mismatchSupplied = Int
expectedTotalRefScriptSize
                    , mismatchExpected :: Int
mismatchExpected = Int
maxRefScriptSizePerBlock
                    }
              )
          ]

  String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"totalRefScriptSizeInBlock" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
    Timelock era
script <- forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature @era (KeyHash 'Witness -> Timelock era)
-> ImpM (LedgerSpec era) (KeyHash 'Witness)
-> ImpM (LedgerSpec era) (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Witness)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    let scriptSize :: Int
scriptSize = Timelock era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize Timelock era
script
    TxIn
scriptSpendIn <- NativeScript era -> ImpTestM era ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript Timelock era
NativeScript era
script ImpTestM era ScriptHash
-> (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ImpM (LedgerSpec era) TxIn
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript
    TxIn
scriptSpendIn2 <- NativeScript era -> ImpTestM era ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript Timelock era
NativeScript era
script ImpTestM era ScriptHash
-> (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ImpM (LedgerSpec era) TxIn
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript
    ProtVer
protVer <- Lens' (PParams era) ProtVer -> ImpTestM era ProtVer
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (ProtVer -> f ProtVer) -> PParams era -> f (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL

    -- We want to verify that the total size of reference scripts in a list of transactions
    -- remains unchanged before and after applying them to the ledger state.
    -- To do this, we generate the expected transactions, simulate submitting them to obtain
    -- their individual reference script sizes, and then restore the original state -
    -- meaning the transactions are not actually applied.
    -- Finally, we check that the accumulated sizes from both before and after match.
    ([(Tx era, Int)], Int)
txsWithRefScriptSizes :: ([(Tx era, Int)], Int) <- ImpTestM era ([(Tx era, Int)], Int)
-> ImpTestM era ([(Tx era, Int)], Int)
forall era a. ImpTestM era a -> ImpTestM era a
simulateThenRestore (ImpTestM era ([(Tx era, Int)], Int)
 -> ImpTestM era ([(Tx era, Int)], Int))
-> ImpTestM era ([(Tx era, Int)], Int)
-> ImpTestM era ([(Tx era, Int)], Int)
forall a b. (a -> b) -> a -> b
$ do
      let mkTxWithExpectedSize :: Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize Int
expectedSize ImpM (LedgerSpec era) (Tx era)
txAction = do
            Tx era
tx <- ImpM (LedgerSpec era) (Tx era)
txAction
            ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer [Item (StrictSeq (Tx era))
Tx era
tx] (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Int
expectedSize
            (Tx era, Int) -> ImpM (LedgerSpec era) (Tx era, Int)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx era
tx, Int
expectedSize)

      -- submit reference scripts
      (Tx era, Int)
refScriptTx1 <-
        Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era, BabbageEraTxBody era) =>
Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize Int
0 (ImpM (LedgerSpec era) (Tx era)
 -> ImpM (LedgerSpec era) (Tx era, Int))
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall a b. (a -> b) -> a -> b
$
          NonEmpty (Script era) -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxOut era) =>
NonEmpty (Script era) -> ImpTestM era (Tx era)
produceRefScriptsTx (NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
script AlonzoScript era
-> [AlonzoScript era] -> NonEmpty (AlonzoScript era)
forall a. a -> [a] -> NonEmpty a
:| [])
      let refScriptTx1In :: TxIn
refScriptTx1In = Int -> Tx era -> TxIn
forall era. (HasCallStack, EraTx era) => Int -> Tx era -> TxIn
txInAt Int
0 ((Tx era, Int) -> Tx era
forall a b. (a, b) -> a
fst (Tx era, Int)
refScriptTx1)
      (Tx era, Int)
refScriptTx2 <-
        Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era, BabbageEraTxBody era) =>
Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize Int
0 (ImpM (LedgerSpec era) (Tx era)
 -> ImpM (LedgerSpec era) (Tx era, Int))
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall a b. (a -> b) -> a -> b
$
          NonEmpty (Script era) -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxOut era) =>
NonEmpty (Script era) -> ImpTestM era (Tx era)
produceRefScriptsTx (NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
script AlonzoScript era
-> [AlonzoScript era] -> NonEmpty (AlonzoScript era)
forall a. a -> [a] -> NonEmpty a
:| [])
      -- spend script using the reference script
      (Tx era, Int)
spendScriptWithRefScriptTx <-
        Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era, BabbageEraTxBody era) =>
Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize Int
scriptSize (ImpM (LedgerSpec era) (Tx era)
 -> ImpM (LedgerSpec era) (Tx era, Int))
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall a b. (a -> b) -> a -> b
$
          TxIn -> NonEmpty TxIn -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
submitTxWithRefInputs TxIn
scriptSpendIn [Item (NonEmpty TxIn)
TxIn
refScriptTx1In]
      -- spend using two ref inputs
      (Tx era, Int)
spendScriptWithTwoRefScriptsTx <-
        Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era, BabbageEraTxBody era) =>
Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
scriptSize) (ImpM (LedgerSpec era) (Tx era)
 -> ImpM (LedgerSpec era) (Tx era, Int))
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall a b. (a -> b) -> a -> b
$
          TxIn -> NonEmpty TxIn -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
submitTxWithRefInputs TxIn
scriptSpendIn2 [Item (NonEmpty TxIn)
TxIn
refScriptTx1In, Int -> Tx era -> TxIn
forall era. (HasCallStack, EraTx era) => Int -> Tx era -> TxIn
txInAt Int
0 ((Tx era, Int) -> Tx era
forall a b. (a, b) -> a
fst (Tx era, Int)
refScriptTx2)]
      -- spend the root utxo
      TxIn
rootIn <- (TxIn, TxOut era) -> TxIn
forall a b. (a, b) -> a
fst ((TxIn, TxOut era) -> TxIn)
-> ImpM (LedgerSpec era) (TxIn, TxOut era)
-> ImpM (LedgerSpec era) TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (TxIn, TxOut era)
forall era. ImpTestM era (TxIn, TxOut era)
getImpRootTxOut
      (Tx era, Int)
spendRootUtxoTx <-
        Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era, BabbageEraTxBody era) =>
Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize Int
scriptSize (ImpM (LedgerSpec era) (Tx era)
 -> ImpM (LedgerSpec era) (Tx era, Int))
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall a b. (a -> b) -> a -> b
$
          TxIn -> NonEmpty TxIn -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
submitTxWithRefInputs TxIn
rootIn [Item (NonEmpty TxIn)
TxIn
refScriptTx1In]
      -- spend the reference script itself
      -- We must check the size without submitting the transaction,
      -- since applying it removes the reference script from the UTxO
      (Tx era, Int)
spendRefScriptTx <-
        Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 AlonzoEraTx era, BabbageEraTxBody era) =>
Int
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
mkTxWithExpectedSize Int
scriptSize (ImpM (LedgerSpec era) (Tx era)
 -> ImpM (LedgerSpec era) (Tx era, Int))
-> ImpM (LedgerSpec era) (Tx era)
-> ImpM (LedgerSpec era) (Tx era, Int)
forall a b. (a -> b) -> a -> b
$
          Tx era -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx era -> ImpTestM era (Tx era)
fixupTx (Tx era -> ImpM (LedgerSpec era) (Tx era))
-> Tx era -> ImpM (LedgerSpec era) (Tx era)
forall a b. (a -> b) -> a -> b
$
            TxIn -> NonEmpty TxIn -> Tx era
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> Tx era
mkTxWithRefInputs TxIn
refScriptTx1In ([TxIn] -> NonEmpty TxIn
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [Item [TxIn]
TxIn
refScriptTx1In])

      let txsWithRefScriptSizes :: [(Tx era, Int)]
txsWithRefScriptSizes =
            [ (Tx era, Int)
Item [(Tx era, Int)]
refScriptTx1
            , (Tx era, Int)
Item [(Tx era, Int)]
refScriptTx2
            , (Tx era, Int)
Item [(Tx era, Int)]
spendScriptWithRefScriptTx
            , (Tx era, Int)
Item [(Tx era, Int)]
spendScriptWithTwoRefScriptsTx
            , (Tx era, Int)
Item [(Tx era, Int)]
spendRootUtxoTx
            , (Tx era, Int)
Item [(Tx era, Int)]
spendRefScriptTx
            ]

      -- check and return the accumulated reference script size of all transactions,
      -- so we can check that the same sum for the unapplied transactions matches
      let expectedTotalRefScriptSize :: Int
expectedTotalRefScriptSize = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
scriptSize
      ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer ([Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
SSeq.fromList ((Tx era, Int) -> Tx era
forall a b. (a, b) -> a
fst ((Tx era, Int) -> Tx era) -> [(Tx era, Int)] -> [Tx era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Tx era, Int)]
txsWithRefScriptSizes))
        (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Int
expectedTotalRefScriptSize
      ([(Tx era, Int)], Int) -> ImpTestM era ([(Tx era, Int)], Int)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Tx era, Int)]
txsWithRefScriptSizes, Int
expectedTotalRefScriptSize)

    let ([(Tx era, Int)]
txWithSizes, Int
expectedTotalSize) = ([(Tx era, Int)], Int)
txsWithRefScriptSizes

    -- for each prefix of the list, the accumulated sum should match the sum of the applied transactions
    [Int]
-> (Int -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int
Item [Int]
1 .. [(Tx era, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Tx era, Int)]
txWithSizes] :: [Int]) ((Int -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) ())
-> (Int -> ImpM (LedgerSpec era) ()) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \Int
ix -> do
      let slice :: [(Tx era, Int)]
slice = Int -> [(Tx era, Int)] -> [(Tx era, Int)]
forall a. Int -> [a] -> [a]
take Int
ix [(Tx era, Int)]
txWithSizes

      ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer ([Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
SSeq.fromList ((Tx era, Int) -> Tx era
forall a b. (a, b) -> a
fst ((Tx era, Int) -> Tx era) -> [(Tx era, Int)] -> [Tx era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Tx era, Int)]
slice))
        (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
          ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (if ProtVer -> Bool
isPostV10 ProtVer
protVer then [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Tx era, Int) -> Int
forall a b. (a, b) -> b
snd ((Tx era, Int) -> Int) -> [(Tx era, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Tx era, Int)]
slice) else Int
0)

    ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer ([Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
SSeq.fromList ((Tx era, Int) -> Tx era
forall a b. (a, b) -> a
fst ((Tx era, Int) -> Tx era) -> [(Tx era, Int)] -> [Tx era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Tx era, Int)]
txWithSizes))
      (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
        ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (if ProtVer -> Bool
isPostV10 ProtVer
protVer then Int
expectedTotalSize else Int
0)

  -- disabled in conformance because submiting phase2-invalid transactions are not supported atm
  SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall era.
SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
disableImpInitPostSubmitTxHook (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Use a reference script in a collateral output" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ProtVer
protVer <- Lens' (PParams era) ProtVer -> ImpTestM era ProtVer
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (ProtVer -> f ProtVer) -> PParams era -> f (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL

      -- produce an utxo with a failing script
      TxIn
failingPlutusTxIn <- do
        let plutus :: Plutus 'PlutusV3
plutus = SLanguage 'PlutusV3 -> Plutus 'PlutusV3
forall (l :: Language). SLanguage l -> Plutus l
alwaysFailsNoDatum SLanguage 'PlutusV3
SPlutusV3
        ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ScriptHash -> ImpM (LedgerSpec era) TxIn
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV3 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript Plutus 'PlutusV3
plutus

      -- produce a utxo with a succeeding script
      Timelock era
script <- forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature @era (KeyHash 'Witness -> Timelock era)
-> ImpM (LedgerSpec era) (KeyHash 'Witness)
-> ImpM (LedgerSpec era) (Timelock era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash 'Witness)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      TxIn
scriptTxIn <- NativeScript era -> ImpTestM era ScriptHash
forall era.
EraScript era =>
NativeScript era -> ImpTestM era ScriptHash
impAddNativeScript Timelock era
NativeScript era
script ImpTestM era ScriptHash
-> (ScriptHash -> ImpM (LedgerSpec era) TxIn)
-> ImpM (LedgerSpec era) TxIn
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScriptHash -> ImpM (LedgerSpec era) TxIn
forall era.
(ShelleyEraImp era, HasCallStack) =>
ScriptHash -> ImpTestM era TxIn
produceScript
      let scriptSize :: Int
scriptSize = Timelock era -> Int
forall t. SafeToHash t => t -> Int
originalBytesSize Timelock era
script

      -- prepare a txout with the succeeding script as reference script
      TxOut era
collRefScriptTxOut <- do
        Addr
addr <- ImpM (LedgerSpec era) Addr
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m Addr
freshKeyAddr_
        TxOut era -> ImpM (LedgerSpec era) (TxOut era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut era -> ImpM (LedgerSpec era) (TxOut era))
-> TxOut era -> ImpM (LedgerSpec era) (TxOut era)
forall a b. (a -> b) -> a -> b
$ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
addr Value era
forall a. Monoid a => a
mempty TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NativeScript era -> Script era
forall era. EraScript era => NativeScript era -> Script era
fromNativeScript Timelock era
NativeScript era
script)

      ([Tx era]
txs :: [Tx era]) <- ImpM (LedgerSpec era) [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall era a. ImpTestM era a -> ImpTestM era a
simulateThenRestore (ImpM (LedgerSpec era) [Tx era] -> ImpM (LedgerSpec era) [Tx era])
-> ImpM (LedgerSpec era) [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall a b. (a -> b) -> a -> b
$ do
        -- submit an invalid transaction which attempts to consume the failing script
        -- and specifies as collateral return the txout with reference script
        Tx era
createCollateralTx <-
          Tx era -> ImpM (LedgerSpec era) (Tx era)
forall era.
(HasCallStack, AlonzoEraImp era,
 InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) =>
Tx era -> ImpTestM era (Tx era)
submitPhase2Invalid (Tx era -> ImpM (LedgerSpec era) (Tx era))
-> Tx era -> ImpM (LedgerSpec era) (Tx era)
forall a b. (a -> b) -> a -> b
$
            TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx
              ( TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
                  TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (Set TxIn)
TxIn
failingPlutusTxIn]
                  TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (TxOut era) -> Identity (StrictMaybe (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (TxOut era))
Lens' (TxBody era) (StrictMaybe (TxOut era))
collateralReturnTxBodyL ((StrictMaybe (TxOut era) -> Identity (StrictMaybe (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut era -> StrictMaybe (TxOut era)
forall a. a -> StrictMaybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxOut era
collRefScriptTxOut
              )
        ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer [Item (StrictSeq (Tx era))
Tx era
createCollateralTx] (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Int
0

        -- consume the script, passing the output from the previous collateral as reference input
        let refScriptTxIn :: TxIn
refScriptTxIn = Int -> Tx era -> TxIn
forall era. (HasCallStack, EraTx era) => Int -> Tx era -> TxIn
txInAt Int
1 Tx era
createCollateralTx
        Tx era
useCollateralTx <- TxIn -> NonEmpty TxIn -> ImpM (LedgerSpec era) (Tx era)
forall era.
(ShelleyEraImp era, BabbageEraTxBody era) =>
TxIn -> NonEmpty TxIn -> ImpTestM era (Tx era)
submitTxWithRefInputs TxIn
scriptTxIn [Item (NonEmpty TxIn)
TxIn
refScriptTxIn]
        ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer [Item (StrictSeq (Tx era))
Tx era
createCollateralTx, Item (StrictSeq (Tx era))
Tx era
useCollateralTx]
          (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` Int
scriptSize
        [Tx era] -> ImpM (LedgerSpec era) [Tx era]
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item [Tx era]
Tx era
createCollateralTx, Item [Tx era]
Tx era
useCollateralTx]

      ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
forall era.
(AlonzoEraTx era, BabbageEraTxBody era) =>
ProtVer -> StrictSeq (Tx era) -> UTxO era -> Int
totalRefScriptSizeInBlock ProtVer
protVer ([Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
SSeq.fromList [Tx era]
txs)
        (UTxO era -> Int)
-> ImpM (LedgerSpec era) (UTxO era) -> ImpM (LedgerSpec era) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (UTxO era)
forall era. ImpTestM era (UTxO era)
getUTxO
          ImpM (LedgerSpec era) Int -> Int -> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` (if ProtVer -> Bool
isPostV10 ProtVer
protVer then Int
scriptSize else Int
0)
  where
    tryRunBBODY :: [Tx era]
-> ImpM
     (LedgerSpec era)
     (Either
        (NonEmpty (PredicateFailure (EraRule "BBODY" era)))
        (State (EraRule "BBODY" era), [Event (EraRule "BBODY" era)]))
tryRunBBODY [Tx era]
txs = do
      let blockBody :: BlockBody era
blockBody = forall era. EraBlockBody era => BlockBody era
mkBasicBlockBody @era BlockBody era -> (BlockBody era -> BlockBody era) -> BlockBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (Tx era) -> Identity (StrictSeq (Tx era)))
-> BlockBody era -> Identity (BlockBody era)
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx era))
Lens' (BlockBody era) (StrictSeq (Tx era))
txSeqBlockBodyL ((StrictSeq (Tx era) -> Identity (StrictSeq (Tx era)))
 -> BlockBody era -> Identity (BlockBody era))
-> StrictSeq (Tx era) -> BlockBody era -> BlockBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
SSeq.fromList [Tx era]
txs
      NewEpochState era
nes <- Getting (NewEpochState era) (ImpTestState era) (NewEpochState era)
-> ImpM (LedgerSpec era) (NewEpochState era)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (NewEpochState era) (ImpTestState era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(NewEpochState era -> f (NewEpochState era))
-> ImpTestState era -> f (ImpTestState era)
impNESL
      let ls :: LedgerState era
ls = NewEpochState era
nes NewEpochState era
-> Getting (LedgerState era) (NewEpochState era) (LedgerState era)
-> LedgerState era
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const (LedgerState era) (EpochState era))
-> NewEpochState era -> Const (LedgerState era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const (LedgerState era) (EpochState era))
 -> NewEpochState era
 -> Const (LedgerState era) (NewEpochState era))
-> ((LedgerState era -> Const (LedgerState era) (LedgerState era))
    -> EpochState era -> Const (LedgerState era) (EpochState era))
-> Getting (LedgerState era) (NewEpochState era) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const (LedgerState era) (LedgerState era))
-> EpochState era -> Const (LedgerState era) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL
          pp :: PParams era
pp = NewEpochState era
nes NewEpochState era
-> Getting (PParams era) (NewEpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const (PParams era) (EpochState era))
-> NewEpochState era -> Const (PParams era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const (PParams era) (EpochState era))
 -> NewEpochState era -> Const (PParams era) (NewEpochState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> EpochState era -> Const (PParams era) (EpochState era))
-> Getting (PParams era) (NewEpochState era) (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL @era
      KeyHash 'BlockIssuer
kh <- ImpM (LedgerSpec era) (KeyHash 'BlockIssuer)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
      SlotNo
slotNo <- Getting SlotNo (ImpTestState era) SlotNo
-> ImpM (LedgerSpec era) SlotNo
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting SlotNo (ImpTestState era) SlotNo
forall era r. Getting r (ImpTestState era) SlotNo
impLastTickG
      let bhView :: BHeaderView
bhView =
            BHeaderView
              { bhviewID :: KeyHash 'BlockIssuer
bhviewID = KeyHash 'BlockIssuer
kh
              , bhviewBSize :: Word32
bhviewBSize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ProtVer -> BlockBody era -> Int
forall era. EraBlockBody era => ProtVer -> BlockBody era -> Int
bBodySize (Version -> Nat -> ProtVer
ProtVer (forall era. Era era => Version
eraProtVerLow @era) Nat
0) BlockBody era
blockBody
              , bhviewHSize :: Int
bhviewHSize = Int
0
              , bhviewBHash :: Hash HASH EraIndependentBlockBody
bhviewBHash = BlockBody era -> Hash HASH EraIndependentBlockBody
forall era.
EraBlockBody era =>
BlockBody era -> Hash HASH EraIndependentBlockBody
hashBlockBody BlockBody era
blockBody
              , bhviewSlot :: SlotNo
bhviewSlot = SlotNo
slotNo
              }
      forall (rule :: Symbol) era.
(STS (EraRule rule era), BaseM (EraRule rule era) ~ ShelleyBase) =>
Environment (EraRule rule era)
-> State (EraRule rule era)
-> Signal (EraRule rule era)
-> ImpTestM
     era
     (Either
        (NonEmpty (PredicateFailure (EraRule rule era)))
        (State (EraRule rule era), [Event (EraRule rule era)]))
tryRunImpRule @"BBODY"
        (PParams era -> ChainAccountState -> BbodyEnv era
forall era. PParams era -> ChainAccountState -> BbodyEnv era
BbodyEnv PParams era
pp (NewEpochState era
nes NewEpochState era
-> Getting ChainAccountState (NewEpochState era) ChainAccountState
-> ChainAccountState
forall s a. s -> Getting a s a -> a
^. Getting ChainAccountState (NewEpochState era) ChainAccountState
forall era. Lens' (NewEpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL))
        (State (EraRule "LEDGERS" era)
-> BlocksMade -> ShelleyBbodyState era
forall era.
State (EraRule "LEDGERS" era)
-> BlocksMade -> ShelleyBbodyState era
BbodyState State (EraRule "LEDGERS" era)
LedgerState era
ls (Map (KeyHash 'StakePool) Nat -> BlocksMade
BlocksMade Map (KeyHash 'StakePool) Nat
forall k a. Map k a
Map.empty))
        (BHeaderView -> BlockBody era -> Block BHeaderView era
forall h era. h -> BlockBody era -> Block h era
Block BHeaderView
bhView BlockBody era
blockBody)
    isPostV10 :: ProtVer -> Bool
isPostV10 ProtVer
protVer = ProtVer -> Version
pvMajor ProtVer
protVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= forall (v :: Nat). (KnownNat v, 0 <= v, v <= MaxVersion) => Version
natVersion @11

-- Generate a list of integers such that the sum of their multiples by scale is greater than toExceed
-- and each individual value multiplied by the scale is smaller than maxSingle
genNumAdditionsExceeding :: Int -> Int -> Int -> ImpTestM era [Int]
genNumAdditionsExceeding :: forall era. Int -> Int -> Int -> ImpTestM era [Int]
genNumAdditionsExceeding Int
sc Int
maxSingle Int
toExceed = Int -> [Int] -> ImpM (LedgerSpec era) [Int]
forall {m :: * -> *}. MonadGen m => Int -> [Int] -> m [Int]
go Int
0 []
  where
    go :: Int -> [Int] -> m [Int]
go Int
tot ![Int]
acc
      | Int
tot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
toExceed = [Int] -> m [Int]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> m [Int]) -> [Int] -> m [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
acc
      | Bool
otherwise = do
          Int
x <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (g :: * -> *) a. (MonadGen g, Random a) => (a, a) -> g a
choose (Int
1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
toExceed Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
sc) (Int
maxSingle Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
sc))
          let !newTot :: Int
newTot = Int
tot Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sc
          Int -> [Int] -> m [Int]
go Int
newTot (Int
x Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
acc)