cardano-ledger-test compiles

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Classes.hs

@@ -690,16 +690,6 @@ unPParams (PParamsF _ p) = p
 pparamsWrapperL :: Lens' (PParamsF era) (PParams era)
 pparamsWrapperL = lens unPParams (\(PParamsF p _) pp -> PParamsF p pp)
 
--- ======
-data FuturePParamsF era where
-  FuturePParamsF :: Proof era -> FuturePParams era -> FuturePParamsF era
-
-unFuturePParams :: FuturePParamsF era -> FuturePParams era
-unFuturePParams (FuturePParamsF _ p) = p
-
-futurePParamsWrapperL :: Lens' (FuturePParamsF era) (FuturePParams era)
-futurePParamsWrapperL = lens unFuturePParams (\(FuturePParamsF p _) pp -> FuturePParamsF p pp)
-
 -- =======
 
 data PParamsUpdateF era where
@@ -811,14 +801,14 @@ genPParams p = case p of
   Babbage -> PParamsF p <$> arbitrary
   Conway -> PParamsF p <$> arbitrary
 
-genFuturePParams :: Proof era -> Gen (FuturePParamsF era)
-genFuturePParams p = case p of
-  Shelley -> FuturePParamsF p <$> arbitrary
-  Allegra -> FuturePParamsF p <$> arbitrary
-  Mary -> FuturePParamsF p <$> arbitrary
-  Alonzo -> FuturePParamsF p <$> arbitrary
-  Babbage -> FuturePParamsF p <$> arbitrary
-  Conway -> FuturePParamsF p <$> arbitrary
+genFuturePParams :: Proof era -> Gen (FuturePParams era)
+genFuturePParams p =
+  frequency
+    [ (2, pure NoPParamsUpdate)
+    , (2, DefinitePParamsUpdate . unPParams <$> genPParams p)
+    , (1, pure (PotentialPParamsUpdate Nothing))
+    , (1, PotentialPParamsUpdate . Just . unPParams <$> genPParams p)
+    ]
 
 genPParamsUpdate :: Proof era -> Gen (PParamsUpdateF era)
 genPParamsUpdate p = case p of

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/LedgerState.hs

@@ -140,11 +140,13 @@ ledgerStatePreds _usize p =
           GovStateConwayToConway ->
             [ Random randomProposals
             , currProposals p :<-: (Constr "reasonable" reasonable ^$ randomProposals)
+            , Random (futurePParams p)
             ]
               ++ prevPulsingPreds p -- Constraints to generate a valid Pulser
           GovStateShelleyToBabbage ->
             [ Sized (Range 0 1) (pparamProposals p)
             , Sized (Range 0 1) (futurePParamProposals p)
+            , Random (futurePParams p)
             ]
        )
   where
@@ -159,7 +161,7 @@ ledgerStateStage ::
 ledgerStateStage usize proof subst0 = do
   let preds = ledgerStatePreds usize proof
   subst <- toolChainSub proof standardOrderInfo preds subst0
-  (_env, status) <- pure (undefined, Nothing) -- monadTyped $ checkForSoundness preds subst
+  (_env, status) <- pure (error "not used in ledgerStateStage", Nothing) -- monadTyped $ checkForSoundness preds subst
   case status of
     Nothing -> pure subst
     Just msg -> error msg

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Preds/UTxO.hs

@@ -58,7 +58,7 @@ utxoStage ::
 utxoStage usize proof subst0 = do
   let preds = utxoPreds usize proof
   subst <- toolChainSub proof standardOrderInfo preds subst0
-  (_env, status) <- pure (undefined, Nothing) -- monadTyped $ checkForSoundness preds subst
+  (_env, status) <- pure (error "not used in utxoStage", Nothing) -- monadTyped $ checkForSoundness preds subst
   case status of
     Nothing -> pure subst
     Just msg -> error msg

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/TypeRep.hs

@@ -125,7 +125,6 @@ import Test.Cardano.Ledger.Alonzo.Arbitrary (genAlonzoPlutusPurposePointer)
 import Test.Cardano.Ledger.Binary.Arbitrary (genByteString)
 import Test.Cardano.Ledger.Constrained.Classes (
   Adds (add, zero),
-  FuturePParamsF (..),
   PParamsF (..),
   PParamsUpdateF (..),
   PlutusPointerF (..),
@@ -277,7 +276,7 @@ data Rep era t where
   UTxOR :: Era era => Proof era -> Rep era (UTxO era)
   TxOutR :: Era era => Proof era -> Rep era (TxOutF era)
   PParamsR :: Era era => Proof era -> Rep era (PParamsF era)
-  FuturePParamsR :: Era era => Proof era -> Rep era (FuturePParamsF era)
+  FuturePParamsR :: Era era => Proof era -> Rep era (FuturePParams era)
   PParamsUpdateR :: Era era => Proof era -> Rep era (PParamsUpdateF era)
   --
   DeltaCoinR :: Rep era DeltaCoin
@@ -608,7 +607,7 @@ synopsis (ValueR p) (ValueF _ x) = show (pcVal p x)
 synopsis (TxOutR p) (TxOutF _ x) = show ((unReflect pcTxOut p x) :: PDoc)
 synopsis (UTxOR p) (UTxO mp) = "UTxO( " ++ synopsis (MapR TxInR (TxOutR p)) (Map.map (TxOutF p) mp) ++ " )"
 synopsis (PParamsR _) (PParamsF p x) = show $ pcPParams p x
-synopsis (FuturePParamsR _) (FuturePParamsF p x) = show $ pcFuturePParams p x
+synopsis (FuturePParamsR p) x = show $ pcFuturePParams p x
 synopsis (PParamsUpdateR _) _ = "PParamsUpdate ..."
 synopsis DeltaCoinR (DeltaCoin n) = show (hsep [ppString "▵₳", ppInteger n])
 synopsis GenDelegPairR x = show (pcGenDelegPair x)
@@ -780,7 +779,7 @@ genSizedRep _ UnitR = arbitrary
 genSizedRep n (PairR a b) = (,) <$> genSizedRep n a <*> genSizedRep n b
 genSizedRep _ RewardR = arbitrary
 genSizedRep n (MaybeR x) = frequency [(1, pure Nothing), (5, Just <$> genSizedRep n x)]
-genSizedRep _ NewEpochStateR = undefined
+genSizedRep _ NewEpochStateR = error "no way to gen a random NewEpochState"
 genSizedRep _ (ProtVerR proof) = genProtVer proof
 genSizedRep n SlotNoR = pure $ SlotNo (fromIntegral n)
 genSizedRep _ SizeR = do lo <- choose (1, 6); hi <- choose (6, 10); pure (SzRng lo hi)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs

@@ -114,7 +114,6 @@ import Numeric.Natural (Natural)
 import Test.Cardano.Ledger.Babbage.Serialisation.Generators ()
 import Test.Cardano.Ledger.Constrained.Ast
 import Test.Cardano.Ledger.Constrained.Classes (
-  FuturePParamsF (..),
   GovState (..),
   PParamsF (..),
   PParamsUpdateF (..),
@@ -408,7 +407,7 @@ futurePParamProposals p = Var (pV p "futurePParamProposals" (MapR GenHashR (PPar
 currPParams :: Era era => Proof era -> Term era (PParamsF era)
 currPParams p = Var (pV p "currPParams" (PParamsR p) No)
 
-futurePParams :: Era era => Proof era -> Term era (FuturePParamsF era)
+futurePParams :: Era era => Proof era -> Term era (FuturePParams era)
 futurePParams p = Var (pV p "futurePParams" (FuturePParamsR p) No)
 
 prevPParams :: Gov.EraGov era => Proof era -> Term era (PParamsF era)
@@ -428,15 +427,15 @@ ppupStateT p =
     :$ Lensed (futurePParamProposals p) (futureProposalsL . proposedMapL p)
     :$ Lensed (currPParams p) (Gov.curPParamsGovStateL . pparamsFL p)
     :$ Lensed (prevPParams p) (Gov.prevPParamsGovStateL . pparamsFL p)
-    :$ Lensed (futurePParams p) (Gov.futurePParamsGovStateL . futurePParamsFL p)
+    :$ Lensed (futurePParams p) (Gov.futurePParamsGovStateL)
   where
-    ppupfun x y (PParamsF _ pp) (PParamsF _ prev) =
+    ppupfun x y (PParamsF _ pp) (PParamsF _ prev) z =
       ShelleyGovState
         (ProposedPPUpdates (Map.map unPParamsUpdate x))
         (ProposedPPUpdates (Map.map unPParamsUpdate y))
         pp
         prev
-        . fmap (\(PParamsF _ fpp) -> fpp)
+        z
 
 govL :: Lens' (GovState era) (Gov.GovState era)
 govL = lens f g
@@ -2055,7 +2054,7 @@ conwayGovStateT p =
     :$ Lensed constitution cgsConstitutionL
     :$ Lensed (currPParams reify) (cgsCurPParamsL . pparamsFL reify)
     :$ Lensed (prevPParams reify) (cgsPrevPParamsL . pparamsFL reify)
-    :$ Lensed (futurePParams reify) (cgsFuturePParamsL . futurePParamsFL reify)
+    :$ Lensed (futurePParams reify) cgsFuturePParamsL
     :$ Shift pulsingPulsingStateT cgsDRepPulsingStateL
 
 -- | The sum of all the 'gasDeposit' fields of 'currProposals'
@@ -2147,9 +2146,6 @@ constitutionChildren = Var $ V "constitutionChildren" (SetR GovActionIdR) No
 pparamsFL :: Proof era -> Lens' (PParams era) (PParamsF era)
 pparamsFL p = lens (PParamsF p) (\_ (PParamsF _ x) -> x)
 
-futurePParamsFL :: Proof era -> Lens' (FuturePParams era) (FuturePParamsF era)
-futurePParamsFL p = lens (FuturePParamsF p) (\_ (FuturePParamsF _ x) -> x)
-
 pparamsMaybeFL :: Proof era -> Lens' (Maybe (PParams era)) (Maybe (PParamsF era))
 pparamsMaybeFL p =
   lens

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/ApplyTx.hs

@@ -168,7 +168,7 @@ applyCert = case reify @era of
   Allegra -> applyShelleyCert
   Alonzo -> applyShelleyCert
   Babbage -> applyShelleyCert
-  Conway -> undefined -- TODO once Conway era is done
+  Conway -> error "applyCert, not yet in Conway"
 
 applyShelleyCert :: forall era. EraPParams era => Model era -> ShelleyTxCert era -> Model era
 applyShelleyCert model dcert = case dcert of

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs

@@ -2827,7 +2827,7 @@ pcShelleyGovState p (ShelleyGovState _proposal _futproposal pp prevpp futurepp)
 pcFuturePParams :: Proof era -> FuturePParams era -> PDoc
 pcFuturePParams p = \case
   NoPParamsUpdate -> ppSexp "NoPParamsUpdate" []
-  PotentialPParamsUpdate mpp -> ppSexp "PotentialPParamsUpdate" [pcPParamsSynopsis p pp | Just pp <- [mpp]]
+  PotentialPParamsUpdate mpp -> ppSexp "PotentialPParamsUpdate" [ppMaybe (pcPParamsSynopsis p) mpp]
   DefinitePParamsUpdate pp -> ppSexp "DefinitePParamsUpdate" [pcPParamsSynopsis p pp]
 
 instance Reflect era => PrettyA (ShelleyGovState era) where