Merge #2716

2716: Update the ledger and improve the compile time of Shelley.Ledger.Query r=mrBliss a=mrBliss

See the individual commits for more details. This is preparation for #2679.

Co-authored-by: Thomas Winant <thomas@well-typed.com>

cabal.project

@@ -152,8 +152,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger-specs
-  tag: 623bbb8d4b13bcb0157c5c576a69536387f1b5be
-  --sha256: 0nspz67p6ixw4zr6q4r2gzn37583mlag8f1g5pk0i4f1yisi69d1
+  tag: c03dd5592bde3bf4f9726f257ba09235aeb4818d
+  --sha256: 1rpjrcc45s58f76zp5mnibqwkgap5yipzgsgp2fhydcysm1rwblf
   subdir:
     byron/chain/executable-spec
     byron/crypto

ouroboros-consensus-byron/src/Ouroboros/Consensus/Byron/Crypto/DSIGN.hs

@@ -42,6 +42,7 @@ import           Cardano.Crypto.Seed (SeedBytesExhausted (..), getBytesFromSeed)
 import qualified Cardano.Crypto.Signing as Crypto
 import qualified Cardano.Crypto.Wallet as CC
 
+import           Ouroboros.Consensus.Util (eitherToMaybe)
 import           Ouroboros.Consensus.Util.Condense
 
 class (HasSignTag a, Decoded a) => ByronSignable a
@@ -122,8 +123,5 @@ instance DSIGNAlgorithm ByronDSIGN where
     rawDeserialiseSigDSIGN bs =
       SigByronDSIGN . Signature <$> (eitherToMaybe $ CC.xsignature bs)
 
-eitherToMaybe :: Either a b -> Maybe b
-eitherToMaybe = either (const Nothing) (Just)
-
 instance Condense (SigDSIGN ByronDSIGN) where
     condense (SigByronDSIGN s) = show s

ouroboros-consensus-cardano-test/src/Test/Consensus/Cardano/MockCrypto.hs

@@ -13,7 +13,7 @@ import           Cardano.Crypto.KES (MockKES)
 import           Cardano.Ledger.Crypto (Crypto (..))
 import           Test.Cardano.Crypto.VRF.Fake (FakeVRF)
 
-import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosCrypto)
+import           Ouroboros.Consensus.Shelley.Protocol.Crypto (PraosCrypto)
 
 -- | A replacement for 'Test.Consensus.Shelley.MockCrypto' that is compatible
 -- with bootstrapping from Byron.
@@ -42,4 +42,4 @@ instance Crypto MockCryptoCompatByron where
   type KES      MockCryptoCompatByron = MockKES 10
   type VRF      MockCryptoCompatByron = FakeVRF
 
-instance TPraosCrypto MockCryptoCompatByron
+instance PraosCrypto MockCryptoCompatByron

ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/CanHardFork.hs

@@ -310,7 +310,7 @@ instance ShelleyBasedEra era => SingleEraBlock (ShelleyBlock era) where
       singleEraName = "Shelley"
     }
 
-instance TPraosCrypto c => HasPartialConsensusConfig (TPraos c) where
+instance PraosCrypto c => HasPartialConsensusConfig (TPraos c) where
   type PartialConsensusConfig (TPraos c) = TPraosParams
 
   completeConsensusConfig _ tpraosEpochInfo tpraosParams = TPraosConfig {..}
@@ -347,7 +347,7 @@ instance ShelleyBasedEra era => HasPartialLedgerConfig (ShelleyBlock era) where
 -------------------------------------------------------------------------------}
 
 type CardanoHardForkConstraints c =
-  ( TPraosCrypto c
+  ( PraosCrypto c
   , ShelleyBasedEra (ShelleyEra c)
   , ShelleyBasedEra (AllegraEra c)
   , ShelleyBasedEra (MaryEra    c)

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Examples.hs

@@ -95,7 +95,7 @@ import qualified Test.Shelley.Spec.Ledger.Utils as SL hiding (mkKeyPair,
 
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto, StandardShelley)
 import           Ouroboros.Consensus.Shelley.Ledger
-import           Ouroboros.Consensus.Shelley.Protocol (TPraosCrypto,
+import           Ouroboros.Consensus.Shelley.Protocol (PraosCrypto,
                      TPraosState (..))
 
 import           Test.Util.Orphans.Arbitrary ()
@@ -236,7 +236,7 @@ examples = Golden.Examples {
         (mkKeyHash 0)
         (SL.emptyPParamsUpdate {SL._keyDeposit = SJust (SL.Coin 100)})
 
-examplePoolDistr :: forall c. TPraosCrypto c => SL.PoolDistr c
+examplePoolDistr :: forall c. PraosCrypto c => SL.PoolDistr c
 examplePoolDistr = SL.PoolDistr $ Map.fromList [
       (mkKeyHash 1, SL.IndividualPoolStake
                       1

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Generators.hs

@@ -26,7 +26,7 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool
 import qualified Shelley.Spec.Ledger.API as SL
 
 import           Ouroboros.Consensus.Shelley.Ledger
-import           Ouroboros.Consensus.Shelley.Protocol (TPraosCrypto,
+import           Ouroboros.Consensus.Shelley.Protocol (PraosCrypto,
                      TPraosState (..))
 
 import           Generic.Random (genericArbitraryU)
@@ -104,7 +104,7 @@ instance CanMock era => Arbitrary (NonMyopicMemberRewards era) where
 instance CanMock era => Arbitrary (Point (ShelleyBlock era)) where
   arbitrary = BlockPoint <$> arbitrary <*> arbitrary
 
-instance TPraosCrypto c => Arbitrary (TPraosState c) where
+instance PraosCrypto c => Arbitrary (TPraosState c) where
   arbitrary = do
       lastSlot <- frequency
         [ (1, return Origin)
@@ -151,7 +151,7 @@ instance Arbitrary (SL.PParams' SL.StrictMaybe era) where
   arbitrary = genericArbitraryU
   shrink    = genericShrink
 
-instance TPraosCrypto c => Arbitrary (SL.ChainDepState c) where
+instance PraosCrypto c => Arbitrary (SL.ChainDepState c) where
   arbitrary = genericArbitraryU
   shrink = genericShrink
 

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs

@@ -29,7 +29,7 @@ import qualified Test.Shelley.Spec.Ledger.Utils as SL (ShelleyTest)
 import           Ouroboros.Consensus.Shelley.Eras (EraCrypto, ShelleyBasedEra,
                      ShelleyEra)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock)
-import           Ouroboros.Consensus.Shelley.Protocol.Crypto (TPraosCrypto)
+import           Ouroboros.Consensus.Shelley.Protocol.Crypto (PraosCrypto)
 
 -- | A mock replacement for 'StandardCrypto'
 --
@@ -48,7 +48,7 @@ instance HashAlgorithm h => Crypto (MockCrypto h) where
 
 type MockShelley h = ShelleyEra (MockCrypto h)
 
-instance HashAlgorithm h => TPraosCrypto (MockCrypto h)
+instance HashAlgorithm h => PraosCrypto (MockCrypto h)
 
 type Block h = ShelleyBlock (MockShelley h)
 

ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs

@@ -143,7 +143,7 @@ data CoreNodeKeyInfo c = CoreNodeKeyInfo
       )
   }
 
-coreNodeKeys :: forall c. TPraosCrypto c => CoreNode c -> CoreNodeKeyInfo c
+coreNodeKeys :: forall c. PraosCrypto c => CoreNode c -> CoreNodeKeyInfo c
 coreNodeKeys CoreNode{cnGenesisKey, cnDelegateKey, cnStakingKey} =
     CoreNodeKeyInfo {
         cnkiCoreNode =
@@ -162,7 +162,7 @@ coreNodeKeys CoreNode{cnGenesisKey, cnDelegateKey, cnStakingKey} =
       }
 
 genCoreNode ::
-     forall c. TPraosCrypto c
+     forall c. PraosCrypto c
   => SL.KESPeriod
   -> Gen (CoreNode c)
 genCoreNode startKESPeriod = do
@@ -200,7 +200,7 @@ genCoreNode startKESPeriod = do
     genSeed :: Integral a => a -> Gen Cardano.Crypto.Seed
     genSeed = fmap mkSeedFromBytes . genBytes
 
-mkLeaderCredentials :: TPraosCrypto c => CoreNode c -> TPraosLeaderCredentials c
+mkLeaderCredentials :: PraosCrypto c => CoreNode c -> TPraosLeaderCredentials c
 mkLeaderCredentials CoreNode { cnDelegateKey, cnVRF, cnKES, cnOCert } =
     TPraosLeaderCredentials {
         tpraosLeaderCredentialsInitSignKey = cnKES
@@ -265,7 +265,7 @@ mkEpochSize (SecurityParam k) f =
 -- but we can configure a potentially lower maximum for the ledger, that's why
 -- we take it as an argument.
 mkGenesisConfig
-  :: forall era. TPraosCrypto (EraCrypto era)
+  :: forall era. PraosCrypto (EraCrypto era)
   => ProtVer   -- ^ Initial protocol version
   -> SecurityParam
   -> Rational  -- ^ Initial active slot coefficient
@@ -510,17 +510,17 @@ initialLovelacePerCoreNode :: Word64
 initialLovelacePerCoreNode = 1000
 
 mkCredential ::
-     TPraosCrypto (EraCrypto era)
+     PraosCrypto (EraCrypto era)
   => SL.SignKeyDSIGN (EraCrypto era) -> SL.Credential r era
 mkCredential = SL.KeyHashObj . mkKeyHash
 
-mkKeyHash :: TPraosCrypto c => SL.SignKeyDSIGN c -> SL.KeyHash r c
+mkKeyHash :: PraosCrypto c => SL.SignKeyDSIGN c -> SL.KeyHash r c
 mkKeyHash = SL.hashKey . mkVerKey
 
-mkVerKey :: TPraosCrypto c => SL.SignKeyDSIGN c -> SL.VKey r c
+mkVerKey :: PraosCrypto c => SL.SignKeyDSIGN c -> SL.VKey r c
 mkVerKey = SL.VKey . deriveVerKeyDSIGN
 
-mkKeyPair :: TPraosCrypto c => SL.SignKeyDSIGN c -> SL.KeyPair r c
+mkKeyPair :: PraosCrypto c => SL.SignKeyDSIGN c -> SL.KeyPair r c
 mkKeyPair sk = SL.KeyPair { vKey = mkVerKey sk, sKey = sk }
 
 mkKeyHashVrf :: (HashAlgorithm h, VRFAlgorithm vrf)

ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal

@@ -36,6 +36,7 @@ library
                        Ouroboros.Consensus.Shelley.Ledger.Ledger
                        Ouroboros.Consensus.Shelley.Ledger.Mempool
                        Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion
+                       Ouroboros.Consensus.Shelley.Ledger.Query
                        Ouroboros.Consensus.Shelley.Ledger.TPraos
                        Ouroboros.Consensus.Shelley.Node
                        Ouroboros.Consensus.Shelley.Node.Serialisation

ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Eras.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE FlexibleContexts        #-}
-{-# LANGUAGE TypeFamilies            #-}
-{-# LANGUAGE UndecidableSuperClasses #-}
 module Ouroboros.Consensus.Shelley.Eras (
     -- * Eras based on the Shelley ledger
     ShelleyEra
@@ -19,12 +16,10 @@ module Ouroboros.Consensus.Shelley.Eras (
   ) where
 
 import           Cardano.Ledger.Era (Crypto)
-import           Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra)
+import           Cardano.Ledger.Shelley (ShelleyEra)
 
-import qualified Shelley.Spec.Ledger.API as SL
-
-import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto,
-                     TPraosCrypto)
+import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
+import           Shelley.Spec.Ledger.API (ShelleyBasedEra)
 
 {-------------------------------------------------------------------------------
   Eras based on the Shelley ledger
@@ -58,20 +53,6 @@ type StandardAllegra = AllegraEra StandardCrypto
 -- | The Mary era with standard crypto
 type StandardMary = MaryEra StandardCrypto
 
-{-------------------------------------------------------------------------------
-  Shelley-based era
--------------------------------------------------------------------------------}
-
--- | Constraints needed by a Shelley-based era
-class ( TPraosCrypto (EraCrypto era)
-      , ShelleyBased            era
-      , SL.ApplyBlock           era
-      , SL.GetLedgerView        era
-      , SL.ApplyTx              era
-      ) => ShelleyBasedEra era
-
-instance TPraosCrypto c => ShelleyBasedEra (ShelleyEra c)
-
 {-------------------------------------------------------------------------------
   Type synonyms for convenience
 -------------------------------------------------------------------------------}

ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger.hs

@@ -9,3 +9,4 @@ import           Ouroboros.Consensus.Shelley.Ledger.Integrity as X
 import           Ouroboros.Consensus.Shelley.Ledger.Ledger as X
 import           Ouroboros.Consensus.Shelley.Ledger.Mempool as X
 import           Ouroboros.Consensus.Shelley.Ledger.NetworkProtocolVersion as X
+import           Ouroboros.Consensus.Shelley.Ledger.Query as X