Merge pull request #1944 from input-output-hk/mrBliss/consensus-requi…

…rements Add classes each era must satisfy for consensus integration
IntersectMBO · Oct 29, 2020 · 5da7dd8 · 5da7dd8
2 parents bf6ae1e + 396acee
commit 5da7dd8
Show file tree

Hide file tree

Showing 11 changed files with 67 additions and 70 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -10,14 +11,16 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
 
 -- | Integration between the Shelley ledger and its corresponding (Transitional
 -- Praos) protocol.
 --
 -- 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
@@ -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
@@ -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/...in-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/BenchmarkFunctions.hs b/...in-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/...n-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/ConcreteCryptoTypes.hs b/...n-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