More TPraos separation

cabal.project

@@ -15,6 +15,7 @@ packages:
   eras/shelley-ma/test-suite
   libs/cardano-ledger-core
   libs/cardano-ledger-example-shelley
+  libs/cardano-ledger-pretty
   libs/cardano-ledger-test
   libs/cardano-protocol-tpraos
   libs/plutus-preprocessor
@@ -162,6 +163,9 @@ package cardano-ledger-core
 package cardano-ledger-example-shelley
   ghc-options: -Werror
 
+package cardano-ledger-pretty
+  ghc-options: -Werror
+
 package cardano-ledger-test
   ghc-options: -Werror
 

eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs

@@ -50,6 +50,7 @@ import qualified Cardano.Ledger.Crypto as CC
 import qualified Cardano.Ledger.Era as EraModule
 import Cardano.Ledger.Keys (GenDelegs (GenDelegs))
 import qualified Cardano.Ledger.Mary.Value as V (Value)
+import Cardano.Ledger.PoolDistr (PoolDistr (..))
 import Cardano.Ledger.Rules.ValidationMode
   ( applySTSNonStatic,
   )
@@ -85,7 +86,6 @@ import Cardano.Ledger.Shelley.UTxO (balance)
 import Cardano.Ledger.ShelleyMA.Rules.Utxo (consumed)
 import Cardano.Ledger.ShelleyMA.Timelocks (validateTimelock)
 import Cardano.Ledger.Val (Val (inject), coin, (<->))
-import Cardano.Protocol.TPraos (PoolDistr (..))
 import qualified Cardano.Protocol.TPraos.Rules.OCert as Shelley
 import qualified Cardano.Protocol.TPraos.Rules.Overlay as Shelley
 import Control.Arrow (left)

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs

@@ -24,12 +24,8 @@ module Cardano.Ledger.Alonzo.Data
     getPlutusData,
     dataHashSize,
     -- $
-    AuxiliaryData (AuxiliaryData, scripts, txMD),
+    AuxiliaryData (AuxiliaryData, AuxiliaryData', scripts, txMD),
     AuxiliaryDataHash (..),
-    -- $
-    ppPlutusData,
-    ppData,
-    ppAuxiliaryData,
   )
 where
 
@@ -45,19 +41,6 @@ import Cardano.Ledger.Hashes
   ( EraIndependentAuxiliaryData,
     EraIndependentData,
   )
-import Cardano.Ledger.Pretty
-  ( PDoc,
-    PrettyA (..),
-    ppInteger,
-    ppList,
-    ppLong,
-    ppMap,
-    ppMetadatum,
-    ppPair,
-    ppSexp,
-    ppStrictSeq,
-    ppWord64,
-  )
 import Cardano.Ledger.SafeHash
   ( HashAnnotated,
     SafeHash,
@@ -121,6 +104,8 @@ pattern Data p <-
   where
     Data p = DataConstr (memoBytes (To p))
 
+{-# COMPLETE Data #-}
+
 getPlutusData :: Data era -> Plutus.Data
 getPlutusData (DataConstr (Memo d _)) = d
 
@@ -297,24 +282,11 @@ pattern AuxiliaryData {txMD, scripts} <-
 
 {-# COMPLETE AuxiliaryData #-}
 
--- =======================================================
-
-ppPlutusData :: Plutus.Data -> PDoc
-ppPlutusData (Plutus.Constr tag args) = ppSexp "Constr" [ppInteger tag, ppList ppPlutusData args]
-ppPlutusData (Plutus.Map pairs) = ppSexp "Map" [ppList (ppPair ppPlutusData ppPlutusData) pairs]
-ppPlutusData (Plutus.List xs) = ppSexp "List" [ppList ppPlutusData xs]
-ppPlutusData (Plutus.I i) = ppSexp "I" [ppInteger i]
-ppPlutusData (Plutus.B bytes) = ppSexp "B" [ppLong bytes]
-
-instance PrettyA Plutus.Data where prettyA = ppPlutusData
-
-ppData :: Data era -> PDoc
-ppData (DataConstr (Memo x _)) = ppSexp "Data" [ppPlutusData x]
-
-instance PrettyA (Data era) where prettyA = ppData
-
-ppAuxiliaryData :: (PrettyA (Core.Script era)) => AuxiliaryData era -> PDoc
-ppAuxiliaryData (AuxiliaryDataConstr (Memo (AuxiliaryDataRaw m s) _)) =
-  ppSexp "AuxiliaryData" [ppMap ppWord64 ppMetadatum m, ppStrictSeq prettyA s]
+pattern AuxiliaryData' ::
+  Map Word64 Metadatum ->
+  StrictSeq (Core.Script era) ->
+  AuxiliaryData era
+pattern AuxiliaryData' txMD_ scripts_ <-
+  AuxiliaryDataConstr (Memo (AuxiliaryDataRaw txMD_ scripts_) _)
 
-instance (PrettyA (Core.Script era)) => PrettyA (AuxiliaryData era) where prettyA = ppAuxiliaryData
+{-# COMPLETE AuxiliaryData' #-}

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Language.hs

@@ -6,7 +6,6 @@
 module Cardano.Ledger.Alonzo.Language where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeWord64)
-import Cardano.Ledger.Pretty (PDoc, PrettyA (..), ppString)
 import Control.DeepSeq (NFData (..))
 import Data.Ix (Ix)
 import qualified Data.Set as Set
@@ -40,11 +39,3 @@ instance FromCBOR Language where
 
 nonNativeLanguages :: Set.Set Language
 nonNativeLanguages = Set.fromList [minBound .. maxBound]
-
--- ==================================
-
-ppLanguage :: Language -> PDoc
-ppLanguage PlutusV1 = ppString "PlutusV1"
-ppLanguage PlutusV2 = ppString "PlutusV2"
-
-instance PrettyA Language where prettyA = ppLanguage

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs

@@ -19,7 +19,6 @@ module Cardano.Ledger.Alonzo.PParams
   ( PParams' (..),
     PParams,
     emptyPParams,
-    ProtVer (..),
     PParamsUpdate,
     emptyPParamsUpdate,
     updatePParams,
@@ -28,8 +27,10 @@ module Cardano.Ledger.Alonzo.PParams
     encodeLangViews,
     retractPP,
     extendPP,
-    ppPParams,
-    ppPParamsUpdate,
+    -- Deprecated
+    ProtVer,
+    pvMajor,
+    pvMinor,
   )
 where
 
@@ -41,48 +42,31 @@ import Cardano.Binary
     serialize',
     serializeEncoding',
   )
-import Cardano.Ledger.Alonzo.Language (Language (..), ppLanguage)
+import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.Scripts
   ( CostModel,
     ExUnits (..),
     Prices (..),
     decodeCostModelMap,
-    ppCostModel,
-    ppExUnits,
-    ppPrices,
   )
 import Cardano.Ledger.BaseTypes
-  ( BoundedRational (unboundRational),
-    NonNegativeInterval,
+  ( NonNegativeInterval,
     Nonce (NeutralNonce),
     StrictMaybe (..),
     UnitInterval,
     fromSMaybe,
     isSNothing,
   )
+import qualified Cardano.Ledger.BaseTypes as BT (ProtVer (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Era
-import Cardano.Ledger.Pretty
-  ( PDoc,
-    PrettyA (prettyA),
-    ppCoin,
-    ppEpochNo,
-    ppMap,
-    ppNatural,
-    ppNonce,
-    ppProtVer,
-    ppRational,
-    ppRecord,
-    ppStrictMaybe,
-    ppUnitInterval,
-  )
 import Cardano.Ledger.Serialization
   ( FromCBORGroup (..),
     ToCBORGroup (..),
     mapToCBOR,
   )
 import Cardano.Ledger.Shelley.Orphans ()
-import Cardano.Ledger.Shelley.PParams (HKD, ProtVer (..))
+import Cardano.Ledger.Shelley.PParams (HKD)
 import qualified Cardano.Ledger.Shelley.PParams as Shelley (PParams' (..))
 import Cardano.Ledger.Slot (EpochNo (..))
 import Control.DeepSeq (NFData)
@@ -147,7 +131,7 @@ data PParams' f era = PParams
     -- | Extra entropy
     _extraEntropy :: !(HKD f Nonce),
     -- | Protocol version
-    _protocolVersion :: !(HKD f ProtVer),
+    _protocolVersion :: !(HKD f BT.ProtVer),
     -- | Minimum Stake Pool Cost
     _minPoolCost :: !(HKD f Coin),
     -- new/updated for alonzo
@@ -291,7 +275,7 @@ emptyPParams =
       _tau = minBound,
       _d = minBound,
       _extraEntropy = NeutralNonce,
-      _protocolVersion = ProtVer 0 0,
+      _protocolVersion = BT.ProtVer 0 0,
       _minPoolCost = mempty,
       -- new/updated for alonzo
       _coinsPerUTxOWord = Coin 0,
@@ -559,73 +543,14 @@ extendPP
   mxCol =
     PParams ma mb mxBB mxT mxBH kd pd emx a n rho tau d eE pv mnP ada cost price mxTx mxBl mxV col mxCol
 
--- ======================================================
--- Pretty instances
-
-ppPParams :: PParams' Identity era -> PDoc
-ppPParams (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mpool ada cost prices mxEx mxBEx mxV c mxC) =
-  ppRecord
-    "PParams"
-    [ ("minfeeA", ppNatural feeA),
-      ("minfeeB", ppNatural feeB),
-      ("maxBBSize", ppNatural mbb),
-      ("maxTxSize", ppNatural mtx),
-      ("maxBHSize", ppNatural mbh),
-      ("keyDeposit", ppCoin kd),
-      ("poolDeposit", ppCoin pd),
-      ("eMax", ppEpochNo em),
-      ("nOpt", ppNatural no),
-      ("a0", ppRational (unboundRational a0)),
-      ("rho", ppUnitInterval rho),
-      ("tau", ppUnitInterval tau),
-      ("d", ppUnitInterval d),
-      ("extraEntropy", ppNonce ex),
-      ("protocolVersion", ppProtVer pv),
-      ("minPoolCost", ppCoin mpool),
-      ("adaPerWord", ppCoin ada),
-      ("costmdls", ppMap ppLanguage ppCostModel cost),
-      ("prices", ppPrices prices),
-      ("maxTxExUnits", ppExUnits mxEx),
-      ("maxBlockExUnits", ppExUnits mxBEx),
-      ("maxValSize", ppNatural mxV),
-      ("collateral%", ppNatural c),
-      ("maxCollateralInputs", ppNatural mxC)
-    ]
-
-instance PrettyA (PParams' Identity era) where
-  prettyA = ppPParams
-
-ppPParamsUpdate :: PParams' StrictMaybe era -> PDoc
-ppPParamsUpdate (PParams feeA feeB mbb mtx mbh kd pd em no a0 rho tau d ex pv mpool ada cost prices mxEx mxBEx mxV c mxC) =
-  ppRecord
-    "PParams"
-    [ ("minfeeA", lift ppNatural feeA),
-      ("minfeeB", lift ppNatural feeB),
-      ("maxBBSize", lift ppNatural mbb),
-      ("maxTxSize", lift ppNatural mtx),
-      ("maxBHSize", lift ppNatural mbh),
-      ("keyDeposit", lift ppCoin kd),
-      ("poolDeposit", lift ppCoin pd),
-      ("eMax", lift ppEpochNo em),
-      ("nOpt", lift ppNatural no),
-      ("a0", lift (ppRational . unboundRational) a0),
-      ("rho", lift ppUnitInterval rho),
-      ("tau", lift ppUnitInterval tau),
-      ("d", lift ppUnitInterval d),
-      ("extraEntropy", lift ppNonce ex),
-      ("protocolVersion", lift ppProtVer pv),
-      ("minPoolCost", lift ppCoin mpool),
-      ("adaPerWord", lift ppCoin ada),
-      ("costmdls", lift (ppMap ppLanguage ppCostModel) cost),
-      ("prices", lift ppPrices prices),
-      ("maxTxExUnits", lift ppExUnits mxEx),
-      ("maxBlockExUnits", lift ppExUnits mxBEx),
-      ("maxValSize", lift ppNatural mxV),
-      ("collateral%", lift ppNatural c),
-      ("maxCollateralInputs", lift ppNatural mxC)
-    ]
-  where
-    lift pp x = ppStrictMaybe pp x
+{-# DEPRECATED ProtVer "Import from Cardano.Ledger.BaseTypes instead" #-}
+
+type ProtVer = BT.ProtVer
+
+{-# DEPRECATED pvMajor "Import from Cardano.Ledger.BaseTypes instead" #-}
+pvMajor :: ProtVer -> Natural
+pvMajor = BT.pvMajor
 
-instance PrettyA (PParams' StrictMaybe era) where
-  prettyA = ppPParamsUpdate
+{-# DEPRECATED pvMinor "Import from Cardano.Ledger.BaseTypes instead" #-}
+pvMinor :: ProtVer -> Natural
+pvMinor = BT.pvMinor

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs

@@ -25,7 +25,6 @@ import Cardano.Binary (FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.Alonzo.Data (getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
-import Cardano.Ledger.Alonzo.PParams (ProtVer)
 import Cardano.Ledger.Alonzo.Scripts (CostModel (..), ExUnits (..))
 import qualified Cardano.Ledger.Alonzo.Scripts as AlonzoScript (Script (..))
 import Cardano.Ledger.Alonzo.Tx
@@ -45,7 +44,7 @@ import Cardano.Ledger.Alonzo.TxInfo
     valContext,
   )
 import Cardano.Ledger.Alonzo.TxWitness (TxWitness (txwitsVKey'), txscripts', unTxDats)
-import Cardano.Ledger.BaseTypes (StrictMaybe (..))
+import Cardano.Ledger.BaseTypes (ProtVer, StrictMaybe (..))
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Credential (Credential (ScriptHashObj))
 import qualified Cardano.Ledger.Crypto as CC (Crypto)

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs

@@ -22,7 +22,6 @@ where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Alonzo.Language (Language)
-import Cardano.Ledger.Alonzo.PParams (ProtVer)
 import Cardano.Ledger.Alonzo.PlutusScriptApi
   ( CollectError,
     collectTwoPhaseScriptInputs,
@@ -41,6 +40,7 @@ import Cardano.Ledger.Alonzo.TxInfo (FailureDescription (..), ScriptResult (..))
 import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo
 import Cardano.Ledger.BaseTypes
   ( Globals,
+    ProtVer,
     ShelleyBase,
     StrictMaybe (..),
     epochInfo,