diff --git a/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs b/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs index 856e0030155..dc74372697c 100644 --- a/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs +++ b/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs @@ -1,34 +1,23 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Allegra where -import Cardano.Crypto.Hash (Hash) -import Cardano.Ledger.Crypto (Crypto, HASH) import Cardano.Ledger.ShelleyMA import Cardano.Ledger.ShelleyMA.Rules.Utxo () import Cardano.Ledger.ShelleyMA.Rules.Utxow () import Cardano.Ledger.ShelleyMA.Scripts () import Cardano.Ledger.ShelleyMA.TxBody () -import Shelley.Spec.Ledger.API (ApplyBlock, ApplyTx, GetLedgerView) -import Shelley.Spec.Ledger.Hashing (EraIndependentTxBody) -import Shelley.Spec.Ledger.Keys (DSignable) +import Shelley.Spec.Ledger.API (ApplyBlock, ApplyTx, GetLedgerView, PraosCrypto, ShelleyBasedEra) type AllegraEra = ShelleyMAEra 'Allegra -instance - ( Crypto c, - DSignable c (Hash (HASH c) EraIndependentTxBody) - ) => - ApplyTx (AllegraEra c) +instance PraosCrypto c => ApplyTx (AllegraEra c) -instance - ( Crypto c, - DSignable c (Hash (HASH c) EraIndependentTxBody) - ) => - ApplyBlock (AllegraEra c) +instance PraosCrypto c => ApplyBlock (AllegraEra c) -instance (Crypto c) => GetLedgerView (AllegraEra c) +instance PraosCrypto c => GetLedgerView (AllegraEra c) + +instance PraosCrypto c => ShelleyBasedEra (AllegraEra c) diff --git a/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs b/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs index bece5927182..0f6af8393fd 100644 --- a/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs +++ b/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs @@ -12,7 +12,7 @@ module Cardano.Ledger.Allegra.Translation where import Cardano.Ledger.Allegra (AllegraEra) import Cardano.Ledger.Crypto (Crypto) import Cardano.Ledger.Era hiding (Crypto) -import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra) +import Cardano.Ledger.Shelley (ShelleyEra) import Control.Iterate.SetAlgebra (biMapFromList, lifo) import Data.Foldable (toList) import qualified Data.Map.Strict as Map @@ -44,8 +44,7 @@ type instance PreviousEra (AllegraEra c) = ShelleyEra c -- to provide the context in the right place. type instance TranslationContext (AllegraEra c) = () -instance (ShelleyBased (AllegraEra c), Crypto c) => TranslateEra (AllegraEra c) NewEpochState where - -- TODO remove the ShelleyBased (AllegraEra c) constraint +instance Crypto c => TranslateEra (AllegraEra c) NewEpochState where translateEra ctxt nes = return $ NewEpochState diff --git a/shelley-ma/impl/src/Cardano/Ledger/Mary.hs b/shelley-ma/impl/src/Cardano/Ledger/Mary.hs index 5c68e0d45ab..0bac603753c 100644 --- a/shelley-ma/impl/src/Cardano/Ledger/Mary.hs +++ b/shelley-ma/impl/src/Cardano/Ledger/Mary.hs @@ -1,34 +1,23 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Mary where -import Cardano.Crypto.Hash (Hash) -import Cardano.Ledger.Crypto (Crypto, HASH) import Cardano.Ledger.ShelleyMA import Cardano.Ledger.ShelleyMA.Rules.Utxo () import Cardano.Ledger.ShelleyMA.Rules.Utxow () import Cardano.Ledger.ShelleyMA.Scripts () import Cardano.Ledger.ShelleyMA.TxBody () -import Shelley.Spec.Ledger.API (ApplyBlock, ApplyTx, GetLedgerView) -import Shelley.Spec.Ledger.Hashing (EraIndependentTxBody) -import Shelley.Spec.Ledger.Keys (DSignable) +import Shelley.Spec.Ledger.API (ApplyBlock, ApplyTx, GetLedgerView, PraosCrypto, ShelleyBasedEra) type MaryEra = ShelleyMAEra 'Mary -instance - ( Crypto c, - DSignable c (Hash (HASH c) EraIndependentTxBody) - ) => - ApplyTx (MaryEra c) +instance PraosCrypto c => ApplyTx (MaryEra c) -instance - ( Crypto c, - DSignable c (Hash (HASH c) EraIndependentTxBody) - ) => - ApplyBlock (MaryEra c) +instance PraosCrypto c => ApplyBlock (MaryEra c) -instance (Crypto c) => GetLedgerView (MaryEra c) +instance PraosCrypto c => GetLedgerView (MaryEra c) + +instance PraosCrypto c => ShelleyBasedEra (MaryEra c) diff --git a/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Scripts.hs b/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Scripts.hs index c42bab95826..b9ab6c4710b 100644 --- a/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Scripts.hs +++ b/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Scripts.hs @@ -32,6 +32,7 @@ import Data.Word (Word8) import GHC.Generics (Generic) import GHC.Records import NoThunks.Class +import Shelley.Spec.Ledger.BaseTypes (invalidKey) import Shelley.Spec.Ledger.Scripts (MultiSig) import Shelley.Spec.Ledger.Tx ( ValidateScript (..), @@ -61,6 +62,7 @@ instance Era era => FromCBOR (Annotator (Script era)) where 1 -> do tl <- fromCBOR pure (2, ScriptTimelock <$> tl) + k -> invalidKey k type instance Core.Script (ShelleyMAEra (ma :: MaryOrAllegra) c) = diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API.hs index 4fe2a93899e..3ed73bc8d71 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API.hs @@ -1,12 +1,30 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + -- | API to the Shelley ledger module Shelley.Spec.Ledger.API ( module X, + ShelleyBasedEra, ) where +import Cardano.Ledger.Era (Crypto) +import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra) import Shelley.Spec.Ledger.API.ByronTranslation as X import Shelley.Spec.Ledger.API.Mempool as X import Shelley.Spec.Ledger.API.Protocol as X import Shelley.Spec.Ledger.API.Types as X import Shelley.Spec.Ledger.API.Validation as X import Shelley.Spec.Ledger.API.Wallet as X + +class + ( PraosCrypto (Crypto era), + ShelleyBased era, + GetLedgerView era, + ApplyBlock era, + ApplyTx era + ) => + ShelleyBasedEra era + +instance PraosCrypto crypto => ShelleyBasedEra (ShelleyEra crypto) diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs index a9161abcf0f..20ff94af14b 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs @@ -18,9 +18,7 @@ module Shelley.Spec.Ledger.API.Mempool where import Cardano.Binary (FromCBOR (..), ToCBOR (..)) -import Cardano.Crypto.Hash (Hash) import Cardano.Ledger.Core (AnnotatedData, ChainData, SerialisableData) -import Cardano.Ledger.Crypto (Crypto, HASH) import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra) import Control.Arrow (left) import Control.Monad.Except @@ -33,15 +31,14 @@ import Control.State.Transition.Extended ) import Data.Sequence (Seq) import Data.Typeable (Typeable) +import Shelley.Spec.Ledger.API.Protocol (PraosCrypto) import Shelley.Spec.Ledger.BaseTypes (Globals) -import Shelley.Spec.Ledger.Keys (DSignable) import Shelley.Spec.Ledger.LedgerState (NewEpochState) import qualified Shelley.Spec.Ledger.LedgerState as LedgerState import Shelley.Spec.Ledger.STS.Ledgers (LEDGERS) import qualified Shelley.Spec.Ledger.STS.Ledgers as Ledgers import Shelley.Spec.Ledger.Slot (SlotNo) import Shelley.Spec.Ledger.Tx (Tx) -import Shelley.Spec.Ledger.TxBody (EraIndependentTxBody) -- TODO #1304: add reapplyTxs class @@ -73,11 +70,7 @@ class where mempoolEnv = mkMempoolEnv state slot -instance - ( Crypto c, - DSignable c (Hash (HASH c) EraIndependentTxBody) - ) => - ApplyTx (ShelleyEra c) +instance PraosCrypto c => ApplyTx (ShelleyEra c) type MempoolEnv era = Ledgers.LedgersEnv era diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Protocol.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Protocol.hs index f602814aced..9f6c468ceae 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Protocol.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Protocol.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} @@ -10,6 +11,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} -- | Integration between the Shelley ledger and its corresponding (Transitional -- Praos) protocol. @@ -17,7 +19,8 @@ -- In particular, this code supports extracting the components of the ledger -- state needed for protocol execution, both now and in a 2k-slot window. module Shelley.Spec.Ledger.API.Protocol - ( GetLedgerView (..), + ( PraosCrypto, + GetLedgerView (..), LedgerView (..), FutureLedgerViewError (..), -- $chainstate @@ -60,7 +63,8 @@ import Shelley.Spec.Ledger.BlockChain prevHashToNonce, ) import Shelley.Spec.Ledger.Delegation.Certificates (PoolDistr) -import Shelley.Spec.Ledger.Keys (DSignable, GenDelegs, KESignable, VRFSignable) +import Shelley.Spec.Ledger.Hashing (EraIndependentTxBody) +import Shelley.Spec.Ledger.Keys (DSignable, GenDelegs, Hash, KESignable, VRFSignable) import Shelley.Spec.Ledger.LedgerState ( EpochState (..), NewEpochState (..), @@ -77,6 +81,15 @@ import qualified Shelley.Spec.Ledger.STS.Tickn as STS.Tickn import Shelley.Spec.Ledger.Serialization (decodeRecordNamed) import Shelley.Spec.Ledger.Slot (SlotNo) +class + ( CC.Crypto c, + DSignable c (OCertSignable c), + DSignable c (Hash c EraIndependentTxBody), + KESignable c (BHBody c), + VRFSignable c Seed + ) => + PraosCrypto c + class ( ChainData (ChainDepState (Crypto era)), SerialisableData (ChainDepState (Crypto era)), @@ -107,7 +120,7 @@ class m (LedgerView (Crypto era)) futureLedgerView = futureView -instance CC.Crypto crypto => GetLedgerView (ShelleyEra crypto) +instance PraosCrypto crypto => GetLedgerView (ShelleyEra crypto) -- | Data required by the Transitional Praos protocol from the Shelley ledger. data LedgerView crypto = LedgerView @@ -305,11 +318,8 @@ tickChainDepState -- This also updates the last applied block hash. updateChainDepState :: forall crypto m. - ( CC.Crypto crypto, - MonadError (ChainTransitionError crypto) m, - DSignable crypto (OCertSignable crypto), - KESignable crypto (BHBody crypto), - VRFSignable crypto Seed + ( PraosCrypto crypto, + MonadError (ChainTransitionError crypto) m ) => Globals -> LedgerView crypto -> @@ -349,11 +359,7 @@ updateChainDepState -- that this is valid through having previously applied it. reupdateChainDepState :: forall crypto. - ( CC.Crypto crypto, - DSignable crypto (OCertSignable crypto), - KESignable crypto (BHBody crypto), - VRFSignable crypto Seed - ) => + PraosCrypto crypto => Globals -> LedgerView crypto -> BHeader crypto -> diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Validation.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Validation.hs index 0bd8532b603..a54227dd3f2 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Validation.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Validation.hs @@ -19,10 +19,7 @@ module Shelley.Spec.Ledger.API.Validation ) where -import Cardano.Crypto.Hash (Hash) import Cardano.Ledger.Core (AnnotatedData, ChainData, SerialisableData) -import Cardano.Ledger.Crypto (HASH) -import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Era (Crypto, Era) import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra) import Control.Arrow (left, right) @@ -31,16 +28,15 @@ import Control.Monad.Trans.Reader (runReader) import Control.State.Transition.Extended import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..)) +import Shelley.Spec.Ledger.API.Protocol (PraosCrypto) import Shelley.Spec.Ledger.BaseTypes (Globals (..)) import Shelley.Spec.Ledger.BlockChain -import Shelley.Spec.Ledger.Keys (DSignable) import Shelley.Spec.Ledger.LedgerState (NewEpochState) import qualified Shelley.Spec.Ledger.LedgerState as LedgerState import qualified Shelley.Spec.Ledger.STS.Bbody as STS import qualified Shelley.Spec.Ledger.STS.Chain as STS import qualified Shelley.Spec.Ledger.STS.Tick as STS import Shelley.Spec.Ledger.Slot (SlotNo) -import Shelley.Spec.Ledger.TxBody (EraIndependentTxBody) {------------------------------------------------------------------------------- Block validation API @@ -137,11 +133,7 @@ class (LedgerState.esLState $ LedgerState.nesEs state) (LedgerState.nesBcur state) -instance - ( CC.Crypto crypto, - DSignable crypto (Hash (HASH crypto) EraIndependentTxBody) - ) => - ApplyBlock (ShelleyEra crypto) +instance PraosCrypto crypto => ApplyBlock (ShelleyEra crypto) {------------------------------------------------------------------------------- CHAIN Transition checks diff --git a/shelley/chain-and-ledger/shelley-spec-ledger-test/bench/Main.hs b/shelley/chain-and-ledger/shelley-spec-ledger-test/bench/Main.hs index a763ddf249f..1411f5dd0c9 100644 --- a/shelley/chain-and-ledger/shelley-spec-ledger-test/bench/Main.hs +++ b/shelley/chain-and-ledger/shelley-spec-ledger-test/bench/Main.hs @@ -41,6 +41,7 @@ import Data.Map (Map) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy (..)) import Data.Word (Word64) +import Shelley.Spec.Ledger.API (PraosCrypto) import Shelley.Spec.Ledger.Bench.Gen ( genBlock, genTriple, @@ -108,6 +109,8 @@ instance CryptoClass.Crypto BenchCrypto where type HASH BenchCrypto = Blake2b_256 type ADDRHASH BenchCrypto = Blake2b_224 +instance PraosCrypto BenchCrypto + type BenchEra = ShelleyEra BenchCrypto -- ============================================================ diff --git a/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/BenchmarkFunctions.hs b/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/BenchmarkFunctions.hs index 3b243815f7f..ff87969aa6c 100644 --- a/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/BenchmarkFunctions.hs +++ b/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/BenchmarkFunctions.hs @@ -39,6 +39,7 @@ import qualified Data.Set as Set import Data.Word (Word64) import Numeric.Natural (Natural) import Shelley.Spec.Ledger.Address (Addr) +import Shelley.Spec.Ledger.API (PraosCrypto) import Shelley.Spec.Ledger.BaseTypes ( Network (..), StrictMaybe (..), @@ -121,6 +122,8 @@ instance Cardano.Ledger.Crypto.Crypto B_Crypto where type HASH B_Crypto = Blake2b_256 type ADDRHASH B_Crypto = Blake2b_256 +instance PraosCrypto B_Crypto + -- ========================================================= aliceStake :: KeyPair 'Staking B_Crypto diff --git a/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs b/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs index 71bb446333e..24fd1e6eb83 100644 --- a/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs +++ b/shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs @@ -21,10 +21,11 @@ import Cardano.Ledger.Crypto import Shelley.Spec.Ledger.BaseTypes (Seed) import Test.Cardano.Crypto.VRF.Fake (FakeVRF) import Cardano.Ledger.Shelley (ShelleyEra) +import Shelley.Spec.Ledger.API (PraosCrypto) -- | Mocking constraints used in generators type Mock c = - ( Cardano.Ledger.Crypto.Crypto c, + ( PraosCrypto c, KES.Signable (KES c) ~ SignableRepresentation, DSIGN.Signable (DSIGN c) ~ SignableRepresentation, @@ -51,3 +52,5 @@ instance Cardano.Ledger.Crypto.Crypto C_Crypto where type DSIGN C_Crypto = MockDSIGN type KES C_Crypto = MockKES 10 type VRF C_Crypto = FakeVRF + +instance PraosCrypto C_Crypto