Merge pull request #5013 from IntersectMBO/td/move-ToPlutusData-instances

Move orphan `ToPlutusData` instances with their types

Author: lehins

eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs

@@ -92,6 +92,7 @@ import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.HKD (HKD, HKDFunctor (..))
 import Cardano.Ledger.Orphans ()
+import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..))
 import Cardano.Ledger.Shelley.PParams (shelleyCommonPParamsHKDPairsV8)
 import Control.DeepSeq (NFData)
 import Data.Aeson as Aeson (
@@ -117,6 +118,10 @@ newtype CoinPerByte = CoinPerByte {unCoinPerByte :: Coin}
   deriving stock (Eq, Ord)
   deriving newtype (EncCBOR, DecCBOR, ToJSON, FromJSON, NFData, NoThunks, Show)
 
+instance ToPlutusData CoinPerByte where
+  toPlutusData (CoinPerByte c) = toPlutusData @Coin c
+  fromPlutusData x = CoinPerByte <$> fromPlutusData @Coin x
+
 class AlonzoEraPParams era => BabbageEraPParams era where
   hkdCoinsPerUTxOByteL :: HKDFunctor f => Lens' (PParamsHKD f era) (HKD f CoinPerByte)
 

eras/conway/impl/CHANGELOG.md

@@ -2,7 +2,7 @@
 
 ## 1.20.0.0
 
-* Add `MkConwayTxBody` and all members of `ConwayTxBodyRaw`:  
+* Add `MkConwayTxBody` and all members of `ConwayTxBodyRaw`:
   (`ConwayTxBodyRaw`, `ctbrAuxDataHash`, `ctbrCerts`, `ctbrCollateralInputs`,
   `ctbrCollateralReturn`, `ctbrCurrentTreasuryValue`, `ctbrFee`, `ctbrMint`, `ctbrNetworkId`,
   `ctbrOutputs`, `ctbrProposalProcedures`, `ctbrReferenceInputs`, `ctbrReqSignerHashes`,
@@ -15,6 +15,7 @@
 * Added `ConwayEraCertState` class
 * Added `ConwayCertState` and related functions
 * Moved `CertState` to `State` module
+* Move `ToPutusData` instances for `CoinPerByte`, `DRepVotingThresholds` and `PoolVotingThresholds` with their respective types
 
 ## 1.19.0.0
 

eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs

@@ -118,6 +118,7 @@ import Cardano.Ledger.Plutus.CostModels (
   mkCostModels,
  )
 import Cardano.Ledger.Plutus.Language (Language (PlutusV3))
+import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..))
 import Cardano.Ledger.Shelley.HardForks (bootstrapPhase)
 import Cardano.Ledger.Val (Val (..))
 import Control.DeepSeq (NFData (..), rwhnf)
@@ -137,6 +138,7 @@ import GHC.Stack (HasCallStack)
 import Lens.Micro
 import NoThunks.Class (NoThunks (..))
 import Numeric.Natural (Natural)
+import qualified PlutusLedgerApi.Common as P (Data (..))
 
 class BabbageEraPParams era => ConwayEraPParams era where
   modifiedPPGroups :: PParamsUpdate era -> Set PPGroups
@@ -291,6 +293,24 @@ instance DecCBOR PoolVotingThresholds where
       pvtPPSecurityGroup <- decCBOR
       pure $ PoolVotingThresholds {..}
 
+instance ToPlutusData PoolVotingThresholds where
+  toPlutusData x =
+    P.List
+      [ toPlutusData (pvtMotionNoConfidence x)
+      , toPlutusData (pvtCommitteeNormal x)
+      , toPlutusData (pvtCommitteeNoConfidence x)
+      , toPlutusData (pvtHardForkInitiation x)
+      , toPlutusData (pvtPPSecurityGroup x)
+      ]
+  fromPlutusData (P.List [a, b, c, d, e]) =
+    PoolVotingThresholds
+      <$> fromPlutusData a
+      <*> fromPlutusData b
+      <*> fromPlutusData c
+      <*> fromPlutusData d
+      <*> fromPlutusData e
+  fromPlutusData _ = Nothing
+
 data DRepVotingThresholds = DRepVotingThresholds
   { dvtMotionNoConfidence :: !UnitInterval
   , dvtCommitteeNormal :: !UnitInterval
@@ -344,6 +364,34 @@ instance FromJSON DRepVotingThresholds where
         <*> o .: "ppGovGroup"
         <*> o .: "treasuryWithdrawal"
 
+instance ToPlutusData DRepVotingThresholds where
+  toPlutusData x =
+    P.List
+      [ toPlutusData (dvtMotionNoConfidence x)
+      , toPlutusData (dvtCommitteeNormal x)
+      , toPlutusData (dvtCommitteeNoConfidence x)
+      , toPlutusData (dvtUpdateToConstitution x)
+      , toPlutusData (dvtHardForkInitiation x)
+      , toPlutusData (dvtPPNetworkGroup x)
+      , toPlutusData (dvtPPEconomicGroup x)
+      , toPlutusData (dvtPPTechnicalGroup x)
+      , toPlutusData (dvtPPGovGroup x)
+      , toPlutusData (dvtTreasuryWithdrawal x)
+      ]
+  fromPlutusData (P.List [a, b, c, d, e, f, g, h, i, j]) =
+    DRepVotingThresholds
+      <$> fromPlutusData a
+      <*> fromPlutusData b
+      <*> fromPlutusData c
+      <*> fromPlutusData d
+      <*> fromPlutusData e
+      <*> fromPlutusData f
+      <*> fromPlutusData g
+      <*> fromPlutusData h
+      <*> fromPlutusData i
+      <*> fromPlutusData j
+  fromPlutusData _ = Nothing
+
 dvtPPNetworkGroupL :: Lens' DRepVotingThresholds UnitInterval
 dvtPPNetworkGroupL = lens dvtPPNetworkGroup (\x y -> x {dvtPPNetworkGroup = y})
 

eras/conway/impl/src/Cardano/Ledger/Conway/Plutus/Context.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Conway.Plutus.Context (
   pparamUpdateToData,
@@ -25,12 +24,9 @@ import Cardano.Ledger.Alonzo.PParams (
   ppuPricesL,
  )
 import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
-import Cardano.Ledger.Babbage.PParams (CoinPerByte (..), ppuCoinsPerUTxOByteL)
-import Cardano.Ledger.Coin (Coin (..))
+import Cardano.Ledger.Babbage.PParams (ppuCoinsPerUTxOByteL)
 import Cardano.Ledger.Conway.PParams (
   ConwayEraPParams (..),
-  DRepVotingThresholds (..),
-  PoolVotingThresholds (..),
   ppuCommitteeMaxTermLengthL,
   ppuCommitteeMinSizeL,
   ppuDRepActivityL,
@@ -103,61 +99,6 @@ pparamUpdateFromData pparamMap (Map pairs) =
       pure (ppu & ppuL .~ SJust val, Map.delete tg leftOverMap)
 pparamUpdateFromData _ _ = Nothing
 
--- ===================================================================
--- ToPlutusData instances necessary for (PParamUpdate (CowayEra c))
-
-instance ToPlutusData PoolVotingThresholds where
-  toPlutusData x =
-    List
-      [ toPlutusData (pvtMotionNoConfidence x)
-      , toPlutusData (pvtCommitteeNormal x)
-      , toPlutusData (pvtCommitteeNoConfidence x)
-      , toPlutusData (pvtHardForkInitiation x)
-      , toPlutusData (pvtPPSecurityGroup x)
-      ]
-  fromPlutusData (List [a, b, c, d, e]) =
-    PoolVotingThresholds
-      <$> fromPlutusData a
-      <*> fromPlutusData b
-      <*> fromPlutusData c
-      <*> fromPlutusData d
-      <*> fromPlutusData e
-  fromPlutusData _ = Nothing
-
-instance ToPlutusData DRepVotingThresholds where
-  toPlutusData x =
-    List
-      [ toPlutusData (dvtMotionNoConfidence x)
-      , toPlutusData (dvtCommitteeNormal x)
-      , toPlutusData (dvtCommitteeNoConfidence x)
-      , toPlutusData (dvtUpdateToConstitution x)
-      , toPlutusData (dvtHardForkInitiation x)
-      , toPlutusData (dvtPPNetworkGroup x)
-      , toPlutusData (dvtPPEconomicGroup x)
-      , toPlutusData (dvtPPTechnicalGroup x)
-      , toPlutusData (dvtPPGovGroup x)
-      , toPlutusData (dvtTreasuryWithdrawal x)
-      ]
-  fromPlutusData (List [a, b, c, d, e, f, g, h, i, j]) =
-    DRepVotingThresholds
-      <$> fromPlutusData a
-      <*> fromPlutusData b
-      <*> fromPlutusData c
-      <*> fromPlutusData d
-      <*> fromPlutusData e
-      <*> fromPlutusData f
-      <*> fromPlutusData g
-      <*> fromPlutusData h
-      <*> fromPlutusData i
-      <*> fromPlutusData j
-  fromPlutusData _ = Nothing
-
-instance ToPlutusData CoinPerByte where
-  toPlutusData (CoinPerByte c) = toPlutusData @Coin c
-  fromPlutusData x = CoinPerByte <$> fromPlutusData @Coin x
-
--- ==========================================================
-
 -- | A Map for the Conway era
 conwayPParamMap :: ConwayEraPParams era => Map Word (PParam era)
 conwayPParamMap = makePParamMap conwayPParam