Got the Alonzo era alomost working, ormolised.

alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/EraGenInstance.hs

@@ -44,7 +44,7 @@ import Shelley.Spec.Ledger.Address (Addr)
 import Shelley.Spec.Ledger.BaseTypes (Network (..), StrictMaybe (..))
 import Shelley.Spec.Ledger.PParams (Update)
 import Shelley.Spec.Ledger.TxBody (DCert, TxIn, Wdrl)
-import Test.Cardano.Ledger.Mary (genMint, maryGenesisValue, policyIndex)
+import Test.Cardano.Ledger.Mary (addTokens, genMint, maryGenesisValue, policyIndex)
 import Test.QuickCheck hiding ((><))
 import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (Mock)
 import Test.Shelley.Spec.Ledger.Generator.Constants (Constants (..))
@@ -120,6 +120,7 @@ unTime (TimelockScript x) = x
 unTime (PlutusScript _) = error "Plutus in Timelock"
 
 genAlonzoTxBody ::
+  forall c.
   Mock c =>
   GenEnv (AlonzoEra c) ->
   Core.PParams (AlonzoEra c) ->
@@ -137,7 +138,7 @@ genAlonzoTxBody _genenv pparams currentslot input txOuts certs wdrls fee updates
   high <- genM (genSlotAfter (currentslot + 50))
   netid <- genM $ frequency [(2, pure Mainnet), (1, pure Testnet)]
   minted <- genMint
-  let (minted2, txouts') = case addTokens pparams minted txOuts of
+  let (minted2, txouts') = case addTokens (Proxy @(AlonzoEra c)) mempty pparams minted txOuts of
         Nothing -> (mempty, txOuts)
         Just os -> (minted, os)
       scriptsFromPolicies = List.map (\p -> (Map.!) policyIndex p) (Set.toList $ policies minted)
@@ -184,44 +185,7 @@ genAlonzoPParamsDelta constants pp = do
   mxV <- genM (genNatural 1 10000)
   pure (Alonzo.extendPP shelleypp ada cost price mxTx mxBl mxV)
 
--- | Attempt to Add tokens to a non-empty list of transaction outputs.
--- It will add them to the first output that has enough lovelace
--- to meet the minUTxO requirment, if such an output exists.
--- Adjusted to handle AonzoEra TxOut
-addTokens ::
-  Mock c =>
-  Core.PParams (AlonzoEra c) ->
-  Value c ->
-  StrictSeq (TxOut (AlonzoEra c)) ->
-  Maybe (StrictSeq (TxOut (AlonzoEra c)))
-addTokens = undefined
-
-{-
-addTokens = addTokens' Empty
-  where
-    -- TODO we used to use _minUTxOValue, but that has become a function of _adaPerUTxOWord
-    -- HOW DO WE COMPENSATE ?
-    minUTxOValue x = Alonzo._adaPerUTxOWord x
-
-    addTokens' tooLittleLovelace pparams ts (o@(TxOut a v zzz) :<| os) =
-      if coin v < scaledMinDeposit v (minUTxOValue pparams)
-        then addTokens' (o :<| tooLittleLovelace) pparams ts os
-        else (Just $ tooLittleLovelace >< TxOut a (v <> ts) zzz <| os)
-    addTokens' _ _ _ Empty = Nothing
--}
-
-{-
-genAlonzoTxOut ::
-  forall era.
-  Gen (Core.Value era) ->
-  [Addr (Crypto era)] ->
-  Gen [Core.TxOut era]
-genTxOut genEraVal addrs = do
-  values <- replicateM (length addrs) genEraVal
-  let pairs = zip addrs values
-  return (uncurry (makeTxOut (Proxy @era)) <$> zip addrs values)
--}
-
+-- | Since Alonzo PParams don't have this field, we have to compute something here.
 instance HasField "_minUTxOValue" (Alonzo.PParams (AlonzoEra c)) Coin where
   getField _ = Coin 4000
 
@@ -232,13 +196,12 @@ instance Mock c => EraGen (AlonzoEra c) where
   updateEraTxBody txb coinx txin txout =
     txb {txinputs_fee = txin, txfee = coinx, outputs = txout}
   genEraPParamsDelta = genAlonzoPParamsDelta
-  genEraTxOut genval addrs = genEraTxOut2 @(AlonzoEra c) genval addrs
   genEraWitnesses setWitVKey = TxWitness setWitVKey Set.empty Map.empty Map.empty (Redeemers Map.empty)
 
 instance Mock c => MinGenTxout (AlonzoEra c) where
   calcEraMinUTxO tout pp = (utxoEntrySize tout <×> getField @"_adaPerUTxOWord" pp)
   addValToTxOut v (TxOut a u b) = TxOut a (v <+> u) b
-  genEraTxOut2 genVal addrs = do
+  genEraTxOut genVal addrs = do
     values <- replicateM (length addrs) genVal
     let pairs = zip addrs values
         makeTxOut (addr, val) = TxOut addr val SNothing

alonzo/impl/test/test/Tests.hs

@@ -25,9 +25,21 @@ import qualified Cardano.Ledger.Core as Core
 
 -- Test.Shelley.Spec.Ledger.Generator.Utxo(genTx)
 
+-- TestPoolReap
+
+-- TestNewEpoch
+
+-- Test Pool
+
+-- Test Delegation
+
+import Cardano.Ledger.Shelley.Constraints (UsesTxBody, UsesTxOut)
+import Control.State.Transition.Trace.Generator.QuickCheck (HasTrace, forAllTraceFromInitState)
 import Data.Proxy (Proxy (..))
+import Shelley.Spec.Ledger.API (ApplyBlock)
 import Shelley.Spec.Ledger.API.Protocol (GetLedgerView)
 import Shelley.Spec.Ledger.API.Validation (ApplyBlock)
+import Shelley.Spec.Ledger.STS.Chain (initialShelleyState)
 import Test.Cardano.Ledger.Alonzo.EraGenInstance ()
 import Test.Cardano.Ledger.Alonzo.Examples.Utxow (plutusScriptExamples, utxowExamples)
 import Test.Cardano.Ledger.Alonzo.Golden as Golden
@@ -36,7 +48,8 @@ import qualified Test.Cardano.Ledger.Alonzo.Serialisation.Tripping as Tripping
 import qualified Test.Cardano.Ledger.Alonzo.Translation as Translation
 import Test.Cardano.Ledger.EraBuffet (TestCrypto)
 import Test.QuickCheck
-import Test.Shelley.Spec.Ledger.Generator.Core (GenEnv)
+import Test.Shelley.Spec.Ledger.Generator.Block (genBlock)
+import Test.Shelley.Spec.Ledger.Generator.Core (GenEnv, mkBlock)
 import Test.Shelley.Spec.Ledger.Generator.EraGen
   ( EraGen (..),
     genEraAuxiliaryData,
@@ -48,7 +61,7 @@ import Test.Shelley.Spec.Ledger.Generator.EraGen
   )
 import Test.Shelley.Spec.Ledger.Generator.Presets (genEnv, genesisDelegs0)
 import Test.Shelley.Spec.Ledger.Generator.ShelleyEraGen ()
-import Test.Shelley.Spec.Ledger.Generator.Trace.Chain (MinCHAINSTS, MinLEDGER, mkGenesisChainState, registerGenesisStaking)
+import Test.Shelley.Spec.Ledger.Generator.Trace.Chain (mkGenesisChainState, registerGenesisStaking)
 import Test.Shelley.Spec.Ledger.Generator.Trace.Ledger (mkGenesisLedgerState)
 import Test.Shelley.Spec.Ledger.PropertyTests
   ( adaPreservationChain,
@@ -66,10 +79,19 @@ import Test.Shelley.Spec.Ledger.PropertyTests
     relevantCasesAreCovered,
     removedAfterPoolreap,
   )
+import Test.Shelley.Spec.Ledger.Rules.TestChain
+  ( adaPreservationChain,
+    collisionFreeComplete,
+    delegProperties,
+    forAllChainTrace,
+    poolProperties,
+    removedAfterPoolreap,
+  )
 import Test.Shelley.Spec.Ledger.Utils
   ( ChainProperty,
     maxLLSupply,
     mkHash,
+    testGlobals,
   )
 import Test.Tasty
 

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Validation.hs

@@ -32,7 +32,7 @@ import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 import Shelley.Spec.Ledger.API.Protocol (PraosCrypto)
 import Shelley.Spec.Ledger.BaseTypes (Globals (..), ShelleyBase)
-import Shelley.Spec.Ledger.BlockChain
+import Shelley.Spec.Ledger.BlockChain (BHeader, Block)
 import Shelley.Spec.Ledger.LedgerState (NewEpochState)
 import qualified Shelley.Spec.Ledger.LedgerState as LedgerState
 import Shelley.Spec.Ledger.PParams (PParams' (..))

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

@@ -81,33 +81,35 @@ import NoThunks.Class(NoThunks)
 import Cardano.Binary(ToCBOR)
 import Cardano.Ledger.Shelley.Constraints(UsesTxBody)
 import Shelley.Spec.Ledger.Serialization(ToCBORGroup)
+import qualified Cardano.Ledger.Era as Era(TxInBlock)
 
 
 -- ======================================================
-
+{-
 type BlockConstraint era =
   ( UsesTxBody era,
     HasField "_d" (Core.PParams era) UnitInterval,
     ToCBORGroup (TxSeq era)
   )
+-}
 
 -- | Type alias for a transaction generator
 type TxGen era =
   Core.PParams era ->
   AccountState ->
   LedgerState era ->
   SlotNo ->
-  Gen (Seq (Core.Tx era))
+  Gen (Seq (Era.TxInBlock era))
 
 -- | Generate a valid block.
 genBlock ::
   forall era.
   ( EraGen era,
-    BlockConstraint era,
+    MinLEDGER_STS era,
+    ToCBORGroup (TxSeq era),
     ApplyBlock era,
     Mock (Crypto era),
     GetLedgerView era,
-    MinLEDGER_STS era,
     QC.HasTrace (Core.EraRule "LEDGERS" era) (GenEnv era)
   ) =>
   GenEnv era ->
@@ -124,7 +126,8 @@ genBlock ge = genBlockWithTxGen genTxs ge
 genBlockWithTxGen ::
   forall era.
   ( EraGen era,
-   BlockConstraint era,
+    MinLEDGER_STS era,
+    ToCBORGroup (TxSeq era),
     Mock (Crypto era),
     GetLedgerView era,
     ApplyBlock era

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

@@ -58,7 +58,7 @@ import Cardano.Ledger.Coin (Coin (..))
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Crypto (DSIGN)
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
-import Cardano.Ledger.Era (Crypto (..))
+import Cardano.Ledger.Era (Crypto (..),TxInBlock)
 import Cardano.Ledger.Hashes (EraIndependentBlockBody)
 import Cardano.Ledger.Shelley.Constraints
   ( UsesTxBody,
@@ -190,7 +190,6 @@ import Test.Shelley.Spec.Ledger.Generator.ScriptClass
 import Test.Shelley.Spec.Ledger.Orphans ()
 import Test.Shelley.Spec.Ledger.Utils
   ( GenesisKeyPair,
-    ShelleyTest,
     epochFromSlotNo,
     evolveKESUntil,
     maxKESIterations,
@@ -204,7 +203,7 @@ import Test.Shelley.Spec.Ledger.Utils
 
 
 import Shelley.Spec.Ledger.Serialization(ToCBORGroup)
-import Cardano.Ledger.Era(SupportsSegWit(toTxSeq,hashTxSeq,unsafeApplyTx))
+import Cardano.Ledger.Era(SupportsSegWit(toTxSeq,hashTxSeq))
 -- import qualified Shelley.Spec.Ledger.BlockChain as Shelley(TxSeq)
 import qualified Cardano.Ledger.Era as Era(TxSeq)
 
@@ -537,7 +536,7 @@ mkBlock ::
   -- | All keys in the stake pool
   AllIssuerKeys (Crypto era) r ->
   -- | Transactions to record
-  [Core.Tx era] ->
+  [TxInBlock era] ->
   -- | Current slot
   SlotNo ->
   -- | Block number/chain length/chain "difficulty"
@@ -552,7 +551,7 @@ mkBlock ::
   OCert (Crypto era) ->
   Block era
 mkBlock prev pkeys txns s blockNo enonce kesPeriod c0 oCert =
-  let txseq = (toTxSeq @era . StrictSeq.fromList) (map (unsafeApplyTx @era) txns)
+  let txseq = (toTxSeq @era . StrictSeq.fromList) txns
       bodySize = fromIntegral $ bBodySize $ txseq
       bodyHash = hashTxSeq @era txseq
       bh = mkBlockHeader prev pkeys s blockNo enonce kesPeriod c0 oCert bodySize bodyHash
@@ -570,7 +569,7 @@ mkBlockFakeVRF ::
   -- | All keys in the stake pool
   AllIssuerKeys (Crypto era) r ->
   -- | Transactions to record
-  [Core.Tx era] ->
+  [TxInBlock era] ->
   -- | Current slot
   SlotNo ->
   -- | Block number/chain length/chain "difficulty"
@@ -593,7 +592,7 @@ mkBlockFakeVRF prev pkeys txns s blockNo enonce (NatNonce bnonce) l kesPeriod c0
       KeyPair vKeyCold _ = cold pkeys
       nonceNonce = mkSeed seedEta s enonce
       leaderNonce = mkSeed seedL s enonce
-      txseq = toTxSeq @era (StrictSeq.fromList (map (unsafeApplyTx @era) txns))
+      txseq = toTxSeq @era (StrictSeq.fromList txns)
       bhb =
         BHBody
           blockNo
@@ -690,7 +689,8 @@ genesisCoins genesisTxId outs =
 -- | Apply a transaction body as a state transition function on the ledger state.
 applyTxBody ::
   forall era.
-  ( ShelleyTest era,
+  ( Era era,
+    Show (Core.TxOut era),
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField

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

@@ -37,7 +37,6 @@ import qualified Cardano.Ledger.Crypto as CC (HASH)
 import Cardano.Ledger.Era (Crypto, ValidateScript (..),TxInBlock)
 import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
 import Cardano.Ledger.Shelley.Constraints (UsesPParams(..))
-import Cardano.Ledger.Tx(Tx(..))
 import Shelley.Spec.Ledger.PParams(Update)
 import Cardano.Slotting.Slot (SlotNo)
 import Data.Coerce (coerce)
@@ -123,12 +122,12 @@ import NoThunks.Class(NoThunks)
 type MinLEDGER_STS era =
   ( Environment (Core.EraRule "LEDGERS" era) ~ LedgersEnv era,
     BaseM (Core.EraRule "LEDGER" era) ~ ShelleyBase,
-    Signal (Core.EraRule "LEDGER" era) ~ Tx era,  -- genBlock takes Tx as input (converts to TxInBlock)
+    Signal (Core.EraRule "LEDGER" era) ~ TxInBlock era,
     State (Core.EraRule "LEDGER" era) ~ (UTxOState era, DPState (Crypto era)),
     Environment (Core.EraRule "LEDGER" era) ~ LedgerEnv era,
     BaseM (Core.EraRule "LEDGERS" era) ~ ShelleyBase,
     State (Core.EraRule "LEDGERS" era) ~ LedgerState era,
-    Signal (Core.EraRule "LEDGERS" era) ~ Seq (Tx era),
+    Signal (Core.EraRule "LEDGERS" era) ~ Seq (TxInBlock era),
     STS (Core.EraRule "LEDGER" era)
   )
 

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Serialisation/EraIndepGenerators.hs

@@ -147,7 +147,7 @@ import Test.Shelley.Spec.Ledger.Serialisation.Generators.Bootstrap
   )
 import Test.Tasty.QuickCheck (Gen, choose, elements)
 import Shelley.Spec.Ledger.Serialization(ToCBORGroup)
-import Cardano.Ledger.Era(TxSeq)
+import Cardano.Ledger.Era(TxSeq,TxInBlock)
 
 
 
@@ -789,9 +789,11 @@ genTx =
     <*> resize maxTxWits arbitrary
     <*> arbitrary
 
+-- | Only usefull in Eras where TxInBlock ~ Tx
 genBlock ::
   forall era.
   ( UsesTxBody era,
+    TxInBlock era ~ Tx era,
     UsesAuxiliary era,
     PreAlonzo era,
     ToCBORGroup (TxSeq era),
@@ -845,7 +847,8 @@ instance
   arbitrary = genTx
 
 instance
-  ( UsesTxBody era,
+  ( TxInBlock era ~ Tx era,
+    UsesTxBody era,
     UsesAuxiliary era,
     PreAlonzo era,
     ToCBORGroup (TxSeq era),

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

@@ -173,31 +173,6 @@ type ShelleyTest era =
   )
 
 
-{-
-type ShelleyUtxoSTS era = --  REPLACED BY Test.Shelley.Spec.Ledger.Generator.Trace.Chain(MinUTXO_STS)
-  ( STS (Core.EraRule "UTXOW" era),
-    BaseM (Core.EraRule "UTXOW" era) ~ ShelleyBase,
-    State (Core.EraRule "UTXO" era) ~ UTxOState era,
-    State (Core.EraRule "UTXOW" era) ~ UTxOState era,
-    Environment (Core.EraRule "UTXOW" era) ~ UtxoEnv era,
-    Environment (Core.EraRule "UTXO" era) ~ UtxoEnv era,
-    Signal (Core.EraRule "UTXOW" era) ~ TxInBlock era    -- TODO FIX ME
-  )
-
-type ShelleyLedgerSTS era = --  REPLACED BY Test.Shelley.Spec.Ledger.Generator.Trace.Chain(MinLEDGER_STS)
-  ( STS (Core.EraRule "LEDGER" era),
-    BaseM (Core.EraRule "LEDGER" era) ~ ShelleyBase,
-    Environment (Core.EraRule "LEDGER" era) ~ LedgerEnv era,
-    State (Core.EraRule "LEDGER" era) ~ (UTxOState era, DPState (Crypto era)),
-    Signal (Core.EraRule "LEDGER" era) ~ Core.Tx era, -- TODO FIX ME
-    STS (Core.EraRule "LEDGERS" era),
-    BaseM (Core.EraRule "LEDGERS" era) ~ ShelleyBase,
-    Environment (Core.EraRule "LEDGERS" era) ~ LedgersEnv era,
-    State (Core.EraRule "LEDGERS" era) ~ LedgerState era,
-    Signal (Core.EraRule "LEDGERS" era) ~ Seq (Core.Tx era) -- TODO FIX ME
-  )
--}
-
 class Split v where
   vsplit :: v -> Integer -> ([v], Coin)
 

shelley/chain-and-ledger/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Examples/EmptyBlock.hs

@@ -11,7 +11,6 @@ module Test.Shelley.Spec.Ledger.Examples.EmptyBlock
 where
 
 import Cardano.Ledger.Era (Crypto (..))
-import Cardano.Ledger.Shelley.Constraints (UsesTxBody)
 import qualified Data.Map.Strict as Map
 import GHC.Stack (HasCallStack)
 import Shelley.Spec.Ledger.BaseTypes (Nonce)
@@ -53,9 +52,8 @@ initStEx1 = initSt (UTxO Map.empty)
 blockEx1 ::
   forall era.
   ( HasCallStack,
-    PreAlonzo era,
-    ExMock (Crypto era),
-    UsesTxBody era
+    ShelleyTest era,
+    ExMock (Crypto era)
   ) =>
   Block era
 blockEx1 =
@@ -76,8 +74,8 @@ blockNonce ::
   forall era.
   ( HasCallStack,
     PreAlonzo era,
-    ExMock (Crypto era),
-    UsesTxBody era
+    ShelleyTest era,
+    ExMock (Crypto era)
   ) =>
   Nonce
 blockNonce = getBlockNonce (blockEx1 @era)