wip

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Generator/Block.hs

@@ -54,6 +54,7 @@ import Test.Shelley.Spec.Ledger.Generator.Core
 import Test.Shelley.Spec.Ledger.Generator.Trace.Ledger ()
 import Test.Shelley.Spec.Ledger.Utils
   ( ShelleyTest,
+    STGens,
     epochFromSlotNo,
     maxKESIterations,
     runShelleyBase,
@@ -73,7 +74,7 @@ type TxGen era =
 -- | Generate a valid block.
 genBlock ::
   forall era.
-  ( ShelleyTest era,
+  ( STGens era,
     GetLedgerView era,
     ApplyBlock era,
     STS (LEDGER era),

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Generator/Presets.hs

@@ -119,7 +119,7 @@ coreNodeKeys c@Constants {numCoreNodes} =
   where
     toKeyPair (sk, vk) = KeyPair vk sk
 
-genUtxo0 :: (ShelleyTest era) => QC.Gen (Core.TxBody era) -> Constants -> Gen (UTxO era)
+genUtxo0 :: (ShelleyTest era) => QC.Gen (Core.Value era) -> Constants -> Gen (UTxO era)
 genUtxo0 gv c@Constants {minGenesisUTxOouts, maxGenesisUTxOouts} = do
   genesisKeys <- someKeyPairs c minGenesisUTxOouts maxGenesisUTxOouts
   genesisScripts <- someScripts c minGenesisUTxOouts maxGenesisUTxOouts

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Generator/Trace/Chain.hs

@@ -58,12 +58,12 @@ import Test.Shelley.Spec.Ledger.Generator.Core (GenEnv (..))
 import Test.Shelley.Spec.Ledger.Generator.Presets (genUtxo0, genesisDelegs0)
 import Test.Shelley.Spec.Ledger.Generator.Update (genPParams)
 import Test.Shelley.Spec.Ledger.Shrinkers (shrinkBlock)
-import Test.Shelley.Spec.Ledger.Utils (ShelleyTest, maxLLSupply, mkHash)
+import Test.Shelley.Spec.Ledger.Utils (ShelleyTest, STGens, maxLLSupply, mkHash)
 
 -- The CHAIN STS at the root of the STS allows for generating blocks of transactions
 -- with meaningful delegation certificates, protocol and application updates, withdrawals etc.
 instance
-  ( ShelleyTest era,
+  ( STGens era,
     GetLedgerView era,
     ApplyBlock era,
     STS (CHAIN era),
@@ -108,7 +108,7 @@ lastByronHeaderHash _ = HashHeader $ mkHash 0
 mkGenesisChainState ::
   forall era a.
   (ShelleyTest era) =>
-  Gen (Core.TxBody era) ->
+  Gen (Core.Value era) ->
   Constants ->
   IRC (CHAIN era) ->
   Gen (Either a (ChainState era))

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Generator/Trace/Ledger.hs

@@ -48,7 +48,7 @@ import Test.Shelley.Spec.Ledger.Generator.Presets (genUtxo0, genesisDelegs0)
 import Test.Shelley.Spec.Ledger.Generator.Update (genPParams)
 import Test.Shelley.Spec.Ledger.Generator.Utxo (genTx)
 import Test.Shelley.Spec.Ledger.Shrinkers (shrinkTx)
-import Test.Shelley.Spec.Ledger.Utils (ShelleyTest, applySTSTest, runShelleyBase)
+import Test.Shelley.Spec.Ledger.Utils (applySTSTest, runShelleyBase, STGens)
 
 genAccountState :: Constants -> Gen AccountState
 genAccountState (Constants {minTreasury, maxTreasury, minReserves, maxReserves}) =
@@ -59,7 +59,7 @@ genAccountState (Constants {minTreasury, maxTreasury, minReserves, maxReserves})
 -- The LEDGER STS combines utxo and delegation rules and allows for generating transactions
 -- with meaningful delegation certificates.
 instance
-  ( ShelleyTest era,
+  ( STGens era,
     STS (LEDGER era),
     BaseM (LEDGER era) ~ ShelleyBase,
     Mock (Crypto era),
@@ -84,7 +84,7 @@ instance
 
 instance
   forall era.
-  ( ShelleyTest era,
+  ( STGens era,
     STS (LEDGER era),
     BaseM (LEDGER era) ~ ShelleyBase,
     Environment (LEDGER era) ~ LedgerEnv era,
@@ -149,7 +149,7 @@ instance
 mkGenesisLedgerState ::
   forall a c.
   (CryptoClass.Crypto c) =>
-  Gen (Core.TxBody (ShelleyEra c)) ->
+  Gen (Core.Value (ShelleyEra c)) ->
   Constants ->
   IRC (LEDGER (ShelleyEra c)) ->
   Gen (Either a (UTxOState (ShelleyEra c), DPState (ShelleyEra c)))

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Generator/Utxo.hs

@@ -33,7 +33,7 @@ import Data.Sequence.Strict (StrictSeq)
 import qualified Data.Sequence.Strict as StrictSeq
 import Data.Set (Set)
 import qualified Data.Set as Set
-import GHC.Records (HasField)
+import GHC.Records (HasField, getField)
 import GHC.Stack (HasCallStack)
 import Shelley.Spec.Ledger.API
   ( DCert,
@@ -312,7 +312,7 @@ genNextDelta
         ksIndexedPayScripts
       }
     )
-  tx
+  tx@(Tx txb _ _)
   delta@(Delta dfees extraInputs extraWitnesses change _ _) =
     let baseTxFee = minfee pparams tx
         encodedLen x = fromIntegral $ BSL.length (serialize x)
@@ -347,12 +347,13 @@ genNextDelta
                     }
               else -- add a new input to cover the fee
               do
+                let instx = getField @"inputs" txb
                 let utxo' =
                       -- Remove possible inputs from Utxo, if they already appear in inputs.
                       UTxO $
                         Map.withoutKeys
                           (unUTxO utxo)
-                          ((getField @"inputs" (_body tx)) <> extraInputs)
+                          (instx <> extraInputs)
                 (inputs, value, (vkeyPairs, msigPairs)) <- genInputs (1, 1) ksIndexedPaymentKeys ksIndexedPayScripts utxo'
                 -- It is possible that the Utxo has no possible inputs left, so fail. We try and keep this from happening
                 -- by using feedback: adding to the number of ouputs (in the call to genRecipients) in genTx above. Adding to the