Delete Praos.Translate module (#1093)

disassembler · web-flow · commit 7565499ac125 · 2024-05-13T17:42:20.000Z
diff --git a/ouroboros-consensus-cardano/changelog.d/proto-translate-javier.md b/ouroboros-consensus-cardano/changelog.d/proto-translate-javier.md
@@ -0,0 +1,3 @@
+### Patch
+
+- Adapt to `Ouroboros.Consensus.Protocol.Praos.Translate` removal.
diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs
@@ -85,7 +85,6 @@ import           Ouroboros.Consensus.Protocol.Praos (Praos)
 import qualified Ouroboros.Consensus.Protocol.Praos as Praos
 import           Ouroboros.Consensus.Protocol.TPraos
 import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos
-import           Ouroboros.Consensus.Protocol.Translate (TranslateProto)
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Node ()
 import           Ouroboros.Consensus.Shelley.Protocol.Praos ()
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/SupportsProtocol.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/SupportsProtocol.hs
@@ -34,11 +34,11 @@ import           Ouroboros.Consensus.HardFork.History.Util
 import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol (..))
+import           Ouroboros.Consensus.Protocol.Abstract (TranslateProto,
+                     translateLedgerView)
 import           Ouroboros.Consensus.Protocol.Praos (Praos)
 import qualified Ouroboros.Consensus.Protocol.Praos.Views as Praos
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
-import           Ouroboros.Consensus.Protocol.Translate (TranslateProto,
-                     translateLedgerView)
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto)
 import           Ouroboros.Consensus.Shelley.Ledger.Block
 import           Ouroboros.Consensus.Shelley.Ledger.Ledger
@@ -113,7 +113,7 @@ instance
   -- ledger view. Ultimately, we will want to liberalise the ledger code
   -- slightly.
   ledgerViewForecastAt cfg st =
-    mapForecast (translateLedgerView @(TPraos crypto) @(Praos crypto)) $
+    mapForecast (translateLedgerView (Proxy @(TPraos crypto, Praos crypto))) $
       ledgerViewForecastAt @(ShelleyBlock (TPraos crypto) era) cfg st'
     where
       st' :: LedgerState (ShelleyBlock (TPraos crypto) era)
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
@@ -44,7 +44,8 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
 import           Ouroboros.Consensus.Forecast
 import qualified Ouroboros.Consensus.Forecast as Forecast
-import           Ouroboros.Consensus.HardFork.Combinator
+import           Ouroboros.Consensus.HardFork.Combinator hiding
+                     (translateChainDepState)
 import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
 import           Ouroboros.Consensus.HardFork.Combinator.State.Types
 import           Ouroboros.Consensus.HardFork.History (Bound (boundSlot))
@@ -53,10 +54,9 @@ import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Ledger.SupportsProtocol
                      (LedgerSupportsProtocol, ledgerViewForecastAt)
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
+import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.Praos
 import           Ouroboros.Consensus.Protocol.TPraos hiding (PraosCrypto)
-import           Ouroboros.Consensus.Protocol.Translate (TranslateProto)
-import qualified Ouroboros.Consensus.Protocol.Translate as Proto
 import           Ouroboros.Consensus.Shelley.Eras
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.Inspect as Shelley.Inspect
@@ -269,7 +269,7 @@ forecastAcrossShelley cfgFrom cfgTo transition forecastFor ledgerStateFrom
           WrapLedgerView
         . either
             (\e -> error ("futureLedgerView failed: " <> show e))
-            (Proto.translateLedgerView @protoFrom @protoTo)
+            (translateLedgerView (Proxy @(protoFrom, protoTo)))
         . runExcept
         . Forecast.forecastFor (ledgerViewForecastAt cfgFrom ledgerStateFrom)
 
@@ -296,7 +296,7 @@ translateChainDepStateAcrossShelley =
         -- Same protocol, same 'ChainDepState'. Note that we don't have to apply
         -- any changes related to an epoch transition, this is already done when
         -- ticking the state.
-        WrapChainDepState $ Proto.translateChainDepState @protoFrom @protoTo chainDepState
+        WrapChainDepState $ translateChainDepState (Proxy @(protoFrom, protoTo)) chainDepState
 
 crossEraForecastAcrossShelley ::
      forall eraFrom eraTo protoFrom protoTo.
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs
@@ -44,7 +44,6 @@ import qualified Ouroboros.Consensus.HardFork.History as History
 import           Ouroboros.Consensus.HeaderValidation (AnnTip)
 import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState (..))
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
 import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs
@@ -39,7 +39,6 @@ import qualified Ouroboros.Consensus.HardFork.History as History
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.Serialisation (Some (..))
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
 import           Ouroboros.Consensus.Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.Block ()
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Api/Protocol/Types.hs
@@ -31,7 +31,6 @@ import qualified Ouroboros.Consensus.Ledger.SupportsProtocol as Consensus
 import           Ouroboros.Consensus.Node.ProtocolInfo (ProtocolClientInfo (..),
                      ProtocolInfo (..))
 import           Ouroboros.Consensus.Node.Run (RunNode)
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
 import qualified Ouroboros.Consensus.Shelley.Eras as Consensus (ShelleyEra)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Consensus
diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBAnalyser/Block/Cardano.hs
@@ -73,7 +73,6 @@ import           Ouroboros.Consensus.HeaderValidation (HasAnnTip)
 import           Ouroboros.Consensus.Ledger.Abstract
 import qualified Ouroboros.Consensus.Mempool as Mempool
 import           Ouroboros.Consensus.Node.ProtocolInfo
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.HFEras ()
 import qualified Ouroboros.Consensus.Shelley.Ledger as Shelley.Ledger
 import           Ouroboros.Consensus.Shelley.Ledger.Block (IsShelleyBlock,
diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs
@@ -30,15 +30,14 @@ import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.HeaderValidation
 import           Ouroboros.Consensus.Ledger.Extended
 import           Ouroboros.Consensus.Ledger.SupportsMempool
+import           Ouroboros.Consensus.Protocol.Abstract (TranslateProto,
+                     translateChainDepState)
 import           Ouroboros.Consensus.Protocol.Praos (Praos)
 import           Ouroboros.Consensus.Protocol.Praos.Header
                      (HeaderBody (HeaderBody))
 import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Protocol.TPraos (TPraos,
                      TPraosState (TPraosState))
-import           Ouroboros.Consensus.Protocol.Translate (TranslateProto,
-                     translateChainDepState)
 import           Ouroboros.Consensus.Shelley.Eras
 import           Ouroboros.Consensus.Shelley.HFEras
 import           Ouroboros.Consensus.Shelley.Ledger
@@ -229,7 +228,7 @@ fromShelleyLedgerExamplesPraos ShelleyLedgerExamples {
     , shelleyLedgerState      = sleNewEpochState
     , shelleyLedgerTransition = ShelleyTransitionInfo {shelleyAfterVoting = 0}
     }
-    chainDepState = translateChainDepState @(TPraos (EraCrypto era)) @(Praos (EraCrypto era))
+    chainDepState = translateChainDepState (Proxy @(TPraos (EraCrypto era), Praos (EraCrypto era)))
       $ TPraosState (NotOrigin 1) sleChainDepState
     extLedgerState = ExtLedgerState
                        ledgerState
diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/DiffusionPipelining.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/DiffusionPipelining.hs
@@ -25,7 +25,6 @@ import           Ouroboros.Consensus.Cardano (CardanoBlock)
 import           Ouroboros.Consensus.HardFork.Combinator
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
 import           Ouroboros.Consensus.Protocol.PBFT
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                      ShelleyCompatible)
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/ByteStringTxParser.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/MiniProtocol/LocalTxSubmission/ByteStringTxParser.hs
@@ -28,7 +28,6 @@ import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                      (latestReleasedNodeVersion, supportedNodeToClientVersions)
 import           Ouroboros.Consensus.Node.Serialisation
                      (SerialiseNodeToClient (decodeNodeToClient))
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.Ledger
                      (CodecConfig (ShelleyCodecConfig))
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportedNetworkProtocolVersion.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/SupportedNetworkProtocolVersion.hs
@@ -5,7 +5,6 @@ module Test.Consensus.Cardano.SupportedNetworkProtocolVersion (tests) where
 import           Data.Proxy
 import           Ouroboros.Consensus.Cardano
 import           Ouroboros.Consensus.Cardano.Block
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
 import           Test.Tasty
 import           Test.Tasty.HUnit
diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/ThreadNet/Cardano.hs
@@ -43,7 +43,6 @@ import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.NodeId
 import           Ouroboros.Consensus.Protocol.PBFT
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
 import           Ouroboros.Consensus.Shelley.Node
 import           Ouroboros.Consensus.Util.IOLike (IOLike)
diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/SupportedNetworkProtocolVersion.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/SupportedNetworkProtocolVersion.hs
@@ -10,7 +10,6 @@ import           Data.Typeable (Typeable)
 import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
                      (SupportedNetworkProtocolVersion)
-import           Ouroboros.Consensus.Protocol.Praos.Translate ()
 import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
 import           Test.Tasty
 import           Test.Tasty.HUnit
diff --git a/ouroboros-consensus-protocol/changelog.d/delete-praos-translate.md b/ouroboros-consensus-protocol/changelog.d/delete-praos-translate.md
@@ -0,0 +1,6 @@
+### Breaking
+
+- Delete `Ouroboros.Consensus.Protocol.Praos.Translate`, moving the orphan
+  instance to `Ouroboros.Consensus.Protocol.Praos`.
+- Delete `Ouroboros.Consensus.Protocol.Translate`, moving `TranslateProto` 
+  to `Ouroboros.Consensus.Protocol.Abstract`.
diff --git a/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal b/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal
@@ -58,11 +58,9 @@ library
     Ouroboros.Consensus.Protocol.Praos
     Ouroboros.Consensus.Protocol.Praos.Common
     Ouroboros.Consensus.Protocol.Praos.Header
-    Ouroboros.Consensus.Protocol.Praos.Translate
     Ouroboros.Consensus.Protocol.Praos.VRF
     Ouroboros.Consensus.Protocol.Praos.Views
     Ouroboros.Consensus.Protocol.TPraos
-    Ouroboros.Consensus.Protocol.Translate
 
   build-depends:
     base >=4.14 && <4.20,
diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE StandaloneDeriving      #-}
 {-# LANGUAGE TypeApplications        #-}
 {-# LANGUAGE TypeFamilies            #-}
+{-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE UndecidableInstances    #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE ViewPatterns            #-}
@@ -38,20 +39,24 @@ import           Cardano.Crypto.VRF (hashVerKeyVRF)
 import qualified Cardano.Crypto.VRF as VRF
 import           Cardano.Ledger.BaseTypes (ActiveSlotCoeff, Nonce, (⭒))
 import qualified Cardano.Ledger.BaseTypes as SL
+import qualified Cardano.Ledger.Chain as SL
 import           Cardano.Ledger.Crypto (Crypto, DSIGN, KES, StandardCrypto, VRF)
 import           Cardano.Ledger.Hashes (EraIndependentTxBody)
 import           Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer),
                      VKey (VKey), coerceKeyRole, hashKey)
 import qualified Cardano.Ledger.Keys as SL
 import           Cardano.Ledger.PoolDistr
                      (IndividualPoolStake (IndividualPoolStake))
-import qualified Cardano.Ledger.Shelley.API as SL
+import qualified Cardano.Ledger.PoolDistr as SL
 import           Cardano.Ledger.Slot (Duration (Duration), (+*))
+import qualified Cardano.Protocol.TPraos.API as SL
 import           Cardano.Protocol.TPraos.BHeader (BoundedNatural (bvValue),
                      checkLeaderNatValue, prevHashToNonce)
 import           Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod),
                      OCert (OCert), OCertSignable)
 import qualified Cardano.Protocol.TPraos.OCert as OCert
+import qualified Cardano.Protocol.TPraos.Rules.Prtcl as SL
+import qualified Cardano.Protocol.TPraos.Rules.Tickn as SL
 import           Cardano.Slotting.EpochInfo (EpochInfo, epochInfoEpoch,
                      epochInfoFirst, hoistEpochInfo)
 import           Cardano.Slotting.Slot (EpochNo (EpochNo), SlotNo (SlotNo),
@@ -84,7 +89,9 @@ import qualified Ouroboros.Consensus.Protocol.Praos.Views as Views
 import           Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF, mkInputVRF,
                      vrfLeaderValue, vrfNonceValue)
 import           Ouroboros.Consensus.Protocol.TPraos
-                     (ConsensusConfig (TPraosConfig, tpraosEpochInfo, tpraosParams))
+                     (ConsensusConfig (TPraosConfig, tpraosEpochInfo, tpraosParams),
+                     TPraos,
+                     TPraosState (tpraosStateChainDepState, tpraosStateLastSlot))
 import           Ouroboros.Consensus.Ticked (Ticked)
 import           Ouroboros.Consensus.Util.Versioned (VersionDecoder (Decode),
                      decodeVersion, encodeVersion)
@@ -681,6 +688,54 @@ instance PraosCrypto c => PraosProtocolSupportsNode (Praos c) where
           praosStateOCertCounters
         } = cdst
 
+{-------------------------------------------------------------------------------
+  Translation from transitional Praos
+-------------------------------------------------------------------------------}
+
+-- | We can translate between TPraos and Praos, provided:
+--
+-- - They share the same HASH algorithm
+-- - They share the same ADDRHASH algorithm
+-- - They share the same DSIGN verification keys
+-- - They share the same VRF verification keys
+instance
+  ( c1 ~ c2 ) =>
+  TranslateProto (TPraos c1) (Praos c2)
+  where
+  translateLedgerView _ SL.LedgerView {SL.lvPoolDistr, SL.lvChainChecks} =
+      Views.LedgerView
+        { Views.lvPoolDistr = coercePoolDistr lvPoolDistr,
+          Views.lvMaxHeaderSize = SL.ccMaxBHSize lvChainChecks,
+          Views.lvMaxBodySize = SL.ccMaxBBSize lvChainChecks,
+          Views.lvProtocolVersion = SL.ccProtocolVersion lvChainChecks
+        }
+      where
+        coercePoolDistr :: SL.PoolDistr c1 -> SL.PoolDistr c2
+        coercePoolDistr (SL.PoolDistr m) =
+          SL.PoolDistr
+            . Map.mapKeysMonotonic coerce
+            . Map.map coerceIndividualPoolStake
+            $ m
+        coerceIndividualPoolStake :: SL.IndividualPoolStake c1 -> SL.IndividualPoolStake c2
+        coerceIndividualPoolStake (SL.IndividualPoolStake stake vrf) =
+          SL.IndividualPoolStake stake $ coerce vrf
+
+  translateChainDepState _ tpState =
+    PraosState
+      { praosStateLastSlot = tpraosStateLastSlot tpState,
+        praosStateOCertCounters = Map.mapKeysMonotonic coerce certCounters,
+        praosStateEvolvingNonce = evolvingNonce,
+        praosStateCandidateNonce = candidateNonce,
+        praosStateEpochNonce = SL.ticknStateEpochNonce csTickn,
+        praosStateLabNonce = csLabNonce,
+        praosStateLastEpochBlockNonce = SL.ticknStatePrevHashNonce csTickn
+      }
+    where
+      SL.ChainDepState {SL.csProtocol, SL.csTickn, SL.csLabNonce} =
+        tpraosStateChainDepState tpState
+      SL.PrtclState certCounters evolvingNonce candidateNonce =
+        csProtocol
+
 {-------------------------------------------------------------------------------
   Util
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Translate.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Translate.hs
diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Translate.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Translate.hs
diff --git a/ouroboros-consensus/changelog.d/proto-translate-javier.md b/ouroboros-consensus/changelog.d/proto-translate-javier.md
@@ -0,0 +1,3 @@
+### Breaking
+
+- New `TranslateProto` class moved from `ouroboros-consensus-protocol`.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs

Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+### Patch`
	`2`	`+`
	`3`	+- Adapt to `Ouroboros.Consensus.Protocol.Praos.Translate` removal.