Define interfaces for consensus

In the `Shelley.Spec.Ledger.API.*` modules, define type classes for the most
important functionality consensus. These classes are parametric in the era.
Instances should be provided for each era (Shelley, Allegra, Mary, etc.). At the
moment, only instances for `ShelleyEra` are provided.

These classes list a bunch of super-class constraints that consensus relies on.
I have tried to be complete, but there's a good chance I forgot to add a few
constraints that are currently already satisfied.

Default implementations are provided for each method so that an empty instance
declaration should be enough for each class + era combination. The constraints
on these instances are what matters, they should be minimal, e.g., just `Crypto
crypto` and `DSignable ..`.

Note: the super-class constraints of the classes are what consensus needs, *not*
what the default implementations of the methods need. If a default
implementation needs more constraints, add them to the *default signature*.

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -11,18 +12,15 @@
 -- | Interface to the Shelley ledger for the purposes of managing a Shelley
 -- mempool.
 module Shelley.Spec.Ledger.API.Mempool
-  ( MempoolEnv,
-    MempoolState,
-    mkMempoolEnv,
-    mkMempoolState,
+  ( ApplyTx (..),
     ApplyTxError (..),
-    applyTxs,
-    overShelleyState,
   )
 where
 
-import Cardano.Binary (FromCBOR (..), ToCBOR (..))
-import Cardano.Ledger.Shelley (ShelleyBased)
+import Cardano.Binary (Annotator, FromCBOR (..), ToCBOR (..))
+import Cardano.Crypto.Hash (Hash)
+import Cardano.Ledger.Crypto (Crypto, HASH)
+import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra)
 import Control.Arrow (left)
 import Control.Monad.Except
 import Control.Monad.Trans.Reader (runReader)
@@ -33,13 +31,57 @@ import Control.State.Transition.Extended
     applySTS,
   )
 import Data.Sequence (Seq)
+import Data.Typeable (Typeable)
+import NoThunks.Class (NoThunks)
 import Shelley.Spec.Ledger.API.Validation
 import Shelley.Spec.Ledger.BaseTypes (Globals)
+import Shelley.Spec.Ledger.Keys (DSignable)
 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
+  ( Eq (Tx era),
+    Show (Tx era),
+    NoThunks (Tx era),
+    FromCBOR (Annotator (Tx era)),
+    ToCBOR (Tx era),
+    Eq (ApplyTxError era),
+    Show (ApplyTxError era),
+    FromCBOR (ApplyTxError era),
+    ToCBOR (ApplyTxError era),
+    Typeable (ApplyTxError era)
+  ) =>
+  ApplyTx era
+  where
+  applyTxs ::
+    MonadError (ApplyTxError era) m =>
+    Globals ->
+    SlotNo ->
+    Seq (Tx era) ->
+    ShelleyState era ->
+    m (ShelleyState era)
+  default applyTxs ::
+    (MonadError (ApplyTxError era) m, STS (LEDGERS era)) =>
+    Globals ->
+    SlotNo ->
+    Seq (Tx era) ->
+    ShelleyState era ->
+    m (ShelleyState era)
+  applyTxs globals slot txs state =
+    overShelleyState (applyTxsTransition globals mempoolEnv txs) state
+    where
+      mempoolEnv = mkMempoolEnv state slot
+
+instance
+  ( Crypto c,
+    DSignable c (Hash (HASH c) EraIndependentTxBody)
+  ) =>
+  ApplyTx (ShelleyEra c)
 
 type MempoolEnv era = Ledgers.LedgersEnv era
 
@@ -108,7 +150,7 @@ instance
   where
   fromCBOR = ApplyTxError <$> fromCBOR
 
-applyTxs ::
+applyTxsTransition ::
   forall era m.
   ( STS (LEDGERS era),
     MonadError (ApplyTxError era) m
@@ -118,7 +160,7 @@ applyTxs ::
   Seq (Tx era) ->
   MempoolState era ->
   m (MempoolState era)
-applyTxs globals env txs state =
+applyTxsTransition globals env txs state =
   let res =
         flip runReader globals
           . applySTS @(LEDGERS era)
@@ -131,9 +173,9 @@ applyTxs globals env txs state =
 -- state.
 overShelleyState ::
   Applicative f =>
-  (MempoolState c -> f (MempoolState c)) ->
-  ShelleyState c ->
-  f (ShelleyState c)
+  (MempoolState era -> f (MempoolState era)) ->
+  ShelleyState era ->
+  f (ShelleyState era)
 overShelleyState f st = do
   res <- f $ mkMempoolState st
   pure $

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Protocol.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -16,11 +17,9 @@
 -- 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
-  ( STS.Prtcl.PrtclEnv,
+  ( GetLedgerView (..),
     LedgerView (..),
-    currentLedgerView,
-    -- $timetravel
-    futureLedgerView,
+    FutureLedgerViewError (..),
     -- $chainstate
     ChainDepState (..),
     ChainTransitionError (..),
@@ -31,13 +30,9 @@ module Shelley.Spec.Ledger.API.Protocol
 where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
-import Cardano.Crypto.DSIGN.Class
-import Cardano.Crypto.KES.Class
-import Cardano.Crypto.VRF.Class
-import Cardano.Ledger.Crypto hiding (Crypto)
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Crypto)
-import Cardano.Ledger.Shelley (ShelleyBased)
+import Cardano.Ledger.Shelley (ShelleyBased, ShelleyEra)
 import Control.Arrow (left, right)
 import Control.Monad.Except
 import Control.Monad.Trans.Reader (runReader)
@@ -65,7 +60,7 @@ import Shelley.Spec.Ledger.BlockChain
     prevHashToNonce,
   )
 import Shelley.Spec.Ledger.Delegation.Certificates (PoolDistr)
-import Shelley.Spec.Ledger.Keys (GenDelegs)
+import Shelley.Spec.Ledger.Keys (DSignable, GenDelegs, KESignable, VRFSignable)
 import Shelley.Spec.Ledger.LedgerState
   ( EpochState (..),
     NewEpochState (..),
@@ -82,6 +77,39 @@ import qualified Shelley.Spec.Ledger.STS.Tickn as STS.Tickn
 import Shelley.Spec.Ledger.Serialization (decodeRecordNamed)
 import Shelley.Spec.Ledger.Slot (SlotNo)
 
+class
+  ( Eq (ChainDepState (Crypto era)),
+    Show (ChainDepState (Crypto era)),
+    NoThunks (ChainDepState (Crypto era)),
+    Eq (ChainTransitionError (Crypto era)),
+    Show (ChainTransitionError (Crypto era)),
+    Show (LedgerView (Crypto era)),
+    Show (FutureLedgerViewError era)
+  ) =>
+  GetLedgerView era
+  where
+  currentLedgerView ::
+    ShelleyState era ->
+    LedgerView (Crypto era)
+  currentLedgerView = view
+
+  -- $timetravel
+  futureLedgerView ::
+    MonadError (FutureLedgerViewError era) m =>
+    Globals ->
+    ShelleyState era ->
+    SlotNo ->
+    m (LedgerView (Crypto era))
+  default futureLedgerView ::
+    (ShelleyBased era, MonadError (FutureLedgerViewError era) m) =>
+    Globals ->
+    ShelleyState era ->
+    SlotNo ->
+    m (LedgerView (Crypto era))
+  futureLedgerView = futureView
+
+instance CC.Crypto crypto => GetLedgerView (ShelleyEra crypto)
+
 -- | Data required by the Transitional Praos protocol from the Shelley ledger.
 data LedgerView crypto = LedgerView
   { lvD :: UnitInterval,
@@ -130,10 +158,6 @@ view
         lvChainChecks = pparamsToChainChecksData . esPp $ nesEs
       }
 
--- | Alias of 'view' for export
-currentLedgerView :: ShelleyState era -> LedgerView (Crypto era)
-currentLedgerView = view
-
 -- $timetravel
 --
 --  Time Travel (or the anachronistic ledger view)
@@ -178,7 +202,7 @@ deriving stock instance
 --   Given a slot within the future stability window from our current slot (the
 --   slot corresponding to the passed-in 'ShelleyState'), return a 'LedgerView'
 --   appropriate to that slot.
-futureLedgerView ::
+futureView ::
   forall era m.
   ( ShelleyBased era,
     MonadError (FutureLedgerViewError era) m
@@ -187,7 +211,7 @@ futureLedgerView ::
   ShelleyState era ->
   SlotNo ->
   m (LedgerView (Crypto era))
-futureLedgerView globals ss slot =
+futureView globals ss slot =
   liftEither
     . right view
     . left (FutureLedgerViewError . join)
@@ -204,8 +228,8 @@ futureLedgerView globals ss slot =
 --
 -- The chain state is an amalgam of the protocol state and the ticked nonce.
 
-data ChainDepState c = ChainDepState
-  { csProtocol :: !(STS.Prtcl.PrtclState c),
+data ChainDepState crypto = ChainDepState
+  { csProtocol :: !(STS.Prtcl.PrtclState crypto),
     csTickn :: !STS.Tickn.TicknState,
     -- | Nonce constructed from the hash of the last applied block header.
     csLabNonce :: !Nonce
@@ -284,15 +308,9 @@ updateChainDepState ::
   forall crypto m.
   ( CC.Crypto crypto,
     MonadError (ChainTransitionError crypto) m,
-    Cardano.Crypto.DSIGN.Class.Signable
-      (DSIGN crypto)
-      (Shelley.Spec.Ledger.OCert.OCertSignable crypto),
-    Cardano.Crypto.KES.Class.Signable
-      (KES crypto)
-      (Shelley.Spec.Ledger.BlockChain.BHBody crypto),
-    Cardano.Crypto.VRF.Class.Signable
-      (VRF crypto)
-      Shelley.Spec.Ledger.BaseTypes.Seed
+    DSignable crypto (OCertSignable crypto),
+    KESignable crypto (BHBody crypto),
+    VRFSignable crypto Seed
   ) =>
   Globals ->
   LedgerView crypto ->
@@ -333,15 +351,9 @@ updateChainDepState
 reupdateChainDepState ::
   forall crypto.
   ( CC.Crypto crypto,
-    Cardano.Crypto.DSIGN.Class.Signable
-      (DSIGN crypto)
-      (Shelley.Spec.Ledger.OCert.OCertSignable crypto),
-    Cardano.Crypto.KES.Class.Signable
-      (KES crypto)
-      (Shelley.Spec.Ledger.BlockChain.BHBody crypto),
-    Cardano.Crypto.VRF.Class.Signable
-      (VRF crypto)
-      Shelley.Spec.Ledger.BaseTypes.Seed
+    DSignable crypto (OCertSignable crypto),
+    KESignable crypto (BHBody crypto),
+    VRFSignable crypto Seed
   ) =>
   Globals ->
   LedgerView crypto ->