diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Block.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Block.hs
index de9e8fa3d4..fe2d5bf6f1 100644
--- a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Block.hs
+++ b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Block.hs
@@ -44,7 +44,13 @@ module Ouroboros.Consensus.Cardano.Block (
   , OneEraTipInfo (TipInfoByron, TipInfoShelley)
     -- * Query
   , CardanoQuery
-  , Query (QueryIfCurrentByron, QueryIfCurrentShelley, QueryAnytimeShelley)
+  , Query (
+        QueryIfCurrentByron
+      , QueryIfCurrentShelley
+      , QueryAnytimeByron
+      , QueryAnytimeShelley
+      , QueryHardFork
+     )
   , CardanoQueryResult
   , Either (QueryResultSuccess, QueryResultEraMismatch)
     -- * CodecConfig
@@ -296,8 +302,8 @@ pattern TipInfoShelley ti = OneEraTipInfo (S (Z (WrapTipInfo ti)))
 -- | The 'Query' of Cardano chain.
 --
 -- Thanks to the pattern synonyms, you can treat this as a sum type with
--- constructors 'QueryIfCurrentByron', 'QueryIfCurerntShelley', and
--- 'QueryAnytimeShelley'.
+-- constructors 'QueryIfCurrentByron', 'QueryIfCurrentShelley',
+-- 'QueryAnytimeByron', 'QueryAnytimeShelley', and 'QueryHardFork'.
 type CardanoQuery sc = Query (CardanoBlock sc)
 
 -- | Byron-specific query that can only be answered when the ledger in the
@@ -314,6 +320,19 @@ pattern QueryIfCurrentShelley
   -> CardanoQuery sc (CardanoQueryResult sc result)
 pattern QueryIfCurrentShelley q = QueryIfCurrent (QS (QZ q))
 
+-- | Query about the Byron era that can be answered anytime, i.e.,
+-- independent from where the tip of the ledger is.
+--
+-- For example, to ask for the start of the Byron era (whether the tip of
+-- the ledger is in the Byron or Shelley era), use:
+--
+-- > QueryAnytimeByron EraStart
+--
+pattern QueryAnytimeByron
+  :: QueryAnytime result
+  -> CardanoQuery sc result
+pattern QueryAnytimeByron q = QueryAnytime q (EraIndex (Z (K ())))
+
 -- | Query about the Shelley era that can be answered anytime, i.e.,
 -- independent from where the tip of the ledger is.
 --
@@ -325,11 +344,13 @@ pattern QueryIfCurrentShelley q = QueryIfCurrent (QS (QZ q))
 pattern QueryAnytimeShelley
   :: QueryAnytime result
   -> CardanoQuery sc result
-pattern QueryAnytimeShelley q = QueryAnytime q (EraIndex (Z (K ())))
+pattern QueryAnytimeShelley q = QueryAnytime q (EraIndex (S (Z (K ()))))
 
 {-# COMPLETE QueryIfCurrentByron
            , QueryIfCurrentShelley
-           , QueryAnytimeShelley #-}
+           , QueryAnytimeByron
+           , QueryAnytimeShelley
+           , QueryHardFork #-}
 
 -- | The result of a 'CardanoQuery'
 --
diff --git a/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Examples.hs b/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Examples.hs
index 9ad0b577bb..f787f6b862 100644
--- a/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Examples.hs
+++ b/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Examples.hs
@@ -37,6 +37,7 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr)
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.Serialisation
 import           Ouroboros.Consensus.TypeFamilyWrappers
+import           Ouroboros.Consensus.Util.Counting (exactlyTwo)
 
 import           Ouroboros.Consensus.HardFork.Combinator
 import           Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common
@@ -147,19 +148,34 @@ injExamplesShelley Golden.Examples {..} = Golden.Examples {
 byronEraParams :: History.EraParams
 byronEraParams = Byron.byronEraParams History.NoLowerBound Byron.dummyConfig
 
+shelleyEraParams :: History.EraParams
+shelleyEraParams = Shelley.shelleyEraParams Shelley.testShelleyGenesis
+
 transitionEpoch :: EpochNo
 transitionEpoch = 10
 
+byronStartBound :: History.Bound
+byronStartBound = History.initBound
+
 byronEndBound :: History.Bound
 byronEndBound =
     History.mkUpperBound
       byronEraParams
-      History.initBound
+      byronStartBound
       transitionEpoch
 
 shelleyStartBound :: History.Bound
 shelleyStartBound = byronEndBound
 
+summary :: History.Summary (CardanoEras Crypto)
+summary =
+    State.reconstructSummary
+      (History.Shape (exactlyTwo byronEraParams shelleyEraParams))
+      (State.TransitionKnown transitionEpoch)
+      (getHardForkLedgerState (ledgerStateByron byronLedger))
+  where
+    (_, byronLedger) = head $ Golden.exampleLedgerState Byron.examples
+
 eraInfoByron :: SingleEraInfo ByronBlock
 eraInfoByron = singleEraInfo (Proxy @ByronBlock)
 
@@ -321,12 +337,16 @@ multiEraExamples = mempty {
         , ("WrongEraShelley", exampleApplyTxErrWrongEraShelley)
         ]
     , Golden.exampleQuery = labelled [
-          ("AnytimeShelley", exampleQueryAnytimeShelley)
+          ("AnytimeByron",   exampleQueryAnytimeByron)
+        , ("AnytimeShelley", exampleQueryAnytimeShelley)
+        , ("HardFork",       exampleQueryHardFork)
         ]
     , Golden.exampleResult = labelled [
           ("EraMismatchByron",   exampleResultEraMismatchByron)
         , ("EraMismatchShelley", exampleResultEraMismatchShelley)
+        , ("AnytimeByron",       exampleResultAnytimeByron)
         , ("AnytimeShelley",     exampleResultAnytimeShelley)
+        , ("HardFork",           exampleResultHardFork)
         ]
     , Golden.exampleLedgerState = labelled [
           ("WithSnapshot", exampleLedgerStateWithSnapshot)
@@ -367,9 +387,17 @@ exampleQueryEraMismatchShelley :: SomeBlock Query (CardanoBlock Crypto)
 exampleQueryEraMismatchShelley =
     SomeBlock (QueryIfCurrentByron Byron.GetUpdateInterfaceState)
 
+exampleQueryAnytimeByron :: SomeBlock Query (CardanoBlock Crypto)
+exampleQueryAnytimeByron =
+    SomeBlock (QueryAnytimeByron GetEraStart)
+
 exampleQueryAnytimeShelley :: SomeBlock Query (CardanoBlock Crypto)
 exampleQueryAnytimeShelley =
-    SomeBlock (QueryAnytimeShelley EraStart)
+    SomeBlock (QueryAnytimeShelley GetEraStart)
+
+exampleQueryHardFork :: SomeBlock Query (CardanoBlock Crypto)
+exampleQueryHardFork =
+    SomeBlock (QueryHardFork GetInterpreter)
 
 exampleResultEraMismatchByron :: SomeResult (CardanoBlock Crypto)
 exampleResultEraMismatchByron =
@@ -383,9 +411,17 @@ exampleResultEraMismatchShelley =
       (QueryIfCurrentByron Byron.GetUpdateInterfaceState)
       (Left exampleEraMismatchShelley)
 
+exampleResultAnytimeByron :: SomeResult (CardanoBlock Crypto)
+exampleResultAnytimeByron =
+    SomeResult (QueryAnytimeByron GetEraStart) (Just byronStartBound)
+
 exampleResultAnytimeShelley :: SomeResult (CardanoBlock Crypto)
 exampleResultAnytimeShelley =
-    SomeResult (QueryAnytimeShelley EraStart) (Just shelleyStartBound)
+    SomeResult (QueryAnytimeShelley GetEraStart) (Just shelleyStartBound)
+
+exampleResultHardFork :: SomeResult (CardanoBlock Crypto)
+exampleResultHardFork =
+    SomeResult (QueryHardFork GetInterpreter) (History.mkInterpreter summary)
 
 exampleLedgerStateWithSnapshot :: LedgerState (CardanoBlock Crypto)
 exampleLedgerStateWithSnapshot =
diff --git a/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Generators.hs b/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Generators.hs
index a6b3312d43..69301f28fe 100644
--- a/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Generators.hs
+++ b/ouroboros-consensus-cardano/test/Test/Consensus/Cardano/Generators.hs
@@ -19,19 +19,22 @@ module Test.Consensus.Cardano.Generators (
 import           Cardano.Crypto.Hash (Hash, HashAlgorithm)
 import           Data.Coerce
 import qualified Data.Map.Strict as Map
+import           Data.Maybe (fromMaybe)
 import           Data.Proxy
-import           Data.SOP.Strict (NP (..), NS (..))
+import           Data.SOP.Strict (NP (..), NS (..), SListI, lengthSList)
 
 import           Test.QuickCheck
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime (RelativeTime (..))
-import           Ouroboros.Consensus.HardFork.History (Bound (..))
+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.Abstract
 import           Ouroboros.Consensus.TypeFamilyWrappers
+import           Ouroboros.Consensus.Util.Counting (NonEmpty (..),
+                     nonEmptyFromList)
 
 import           Ouroboros.Consensus.HardFork.Combinator
 import           Ouroboros.Consensus.HardFork.Combinator.Serialisation
@@ -67,14 +70,14 @@ instance HashAlgorithm h => Arbitrary (CardanoBlock (TPraosMockCrypto h)) where
 instance HashAlgorithm h => Arbitrary (CardanoHeader (TPraosMockCrypto h)) where
   arbitrary = getHeader <$> arbitrary
 
--- TODO if we try to use arbitrary instances for `SlotNo` and `EpochNo` here, we
+-- TODO if we try to use arbitrary instances for 'SlotNo' and 'EpochNo' here, we
 -- hit a conflict, since they exist both in byron generators and shelley
 -- generators.
-instance Arbitrary Bound where
+instance Arbitrary History.Bound where
   arbitrary =
-    Bound <$> (RelativeTime <$> arbitrary)
-          <*> (SlotNo <$> arbitrary)
-          <*> (EpochNo <$> arbitrary)
+      History.Bound <$> (RelativeTime <$> arbitrary)
+                    <*> (SlotNo       <$> arbitrary)
+                    <*> (EpochNo      <$> arbitrary)
 
 arbitraryHardForkState
   :: forall f sc a.
@@ -292,33 +295,90 @@ instance (sc ~ TPraosMockCrypto h, HashAlgorithm h, forall a. Arbitrary (Hash h
       ]
 
 instance Arbitrary (Some QueryAnytime) where
-  arbitrary = return $ Some EraStart
+  arbitrary = return $ Some GetEraStart
+
+instance Arbitrary (Some (QueryHardFork (CardanoEras sc))) where
+  arbitrary = return $ Some GetInterpreter
 
 instance (sc ~ TPraosMockCrypto h, HashAlgorithm h)
       => Arbitrary (WithVersion (HardForkNodeToClientVersion (CardanoEras sc))
                                 (SomeBlock Query (CardanoBlock sc))) where
   arbitrary = frequency
-      [ (9, arbitraryNodeToClient injByron injShelley)
+      [ (1, arbitraryNodeToClient injByron injShelley)
+      , (1, WithVersion
+              <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
+              <*> (injAnytimeByron <$> arbitrary))
       , (1, WithVersion
               <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
               <*> (injAnytimeShelley <$> arbitrary))
+      , (1, WithVersion
+              <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
+              <*> (injHardFork <$> arbitrary))
       ]
     where
       injByron          (SomeBlock query) = SomeBlock (QueryIfCurrentByron   query)
       injShelley        (SomeBlock query) = SomeBlock (QueryIfCurrentShelley query)
+      injAnytimeByron   (Some      query) = SomeBlock (QueryAnytimeByron     query)
       injAnytimeShelley (Some      query) = SomeBlock (QueryAnytimeShelley   query)
+      injHardFork       (Some      query) = SomeBlock (QueryHardFork         query)
+
+instance Arbitrary History.EraEnd where
+  arbitrary = oneof
+      [ History.EraEnd <$> arbitrary
+      , return History.EraUnbounded
+      ]
+
+instance Arbitrary History.SafeBeforeEpoch where
+  arbitrary = oneof
+      [ return History.NoLowerBound
+      , History.LowerBound . EpochNo <$> arbitrary
+      , return History.UnsafeUnbounded
+      ]
+
+instance Arbitrary History.SafeZone where
+  arbitrary = History.SafeZone
+      <$> arbitrary
+      <*> arbitrary
+
+instance Arbitrary History.EraParams where
+  arbitrary = History.EraParams
+      <$> (EpochSize <$> arbitrary)
+      <*> arbitrary
+      <*> arbitrary
+
+instance Arbitrary History.EraSummary where
+  arbitrary = History.EraSummary
+      <$> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+
+instance (Arbitrary a, SListI xs) => Arbitrary (NonEmpty xs a) where
+  arbitrary = do
+      let nbXs = lengthSList (Proxy @xs)
+      len <- choose (1, nbXs)
+      xs  <- vectorOf len arbitrary
+      return $ fromMaybe (error "nonEmptyFromList failed") $ nonEmptyFromList xs
+
+instance Arbitrary (History.Interpreter (CardanoEras sc)) where
+  arbitrary = History.mkInterpreter . History.Summary <$> arbitrary
 
 instance (sc ~ TPraosMockCrypto h, HashAlgorithm h)
       => Arbitrary (WithVersion (HardForkNodeToClientVersion (CardanoEras sc))
                                 (SomeResult (CardanoBlock sc))) where
   arbitrary = frequency
-      [ (8, arbitraryNodeToClient injByron injShelley)
-      , (2, WithVersion
+      [ (1, arbitraryNodeToClient injByron injShelley)
+      , (1, WithVersion
               <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
               <*> genQueryIfCurrentResultEraMismatch)
       , (1, WithVersion
               <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
-              <*> genQueryAnytimeResult)
+              <*> genQueryAnytimeResultByron)
+      , (1, WithVersion
+              <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
+              <*> genQueryAnytimeResultShelley)
+      , (1, WithVersion
+              <$> (getHardForkEnabledNodeToClientVersion <$> arbitrary)
+              <*> genQueryHardForkResult)
       ]
     where
       injByron   (SomeResult q r) = SomeResult (QueryIfCurrentByron   q) (QueryResultSuccess r)
@@ -339,9 +399,17 @@ instance (sc ~ TPraosMockCrypto h, HashAlgorithm h)
               <$> arbitrary <*> arbitrary
           ]
 
-      genQueryAnytimeResult :: Gen (SomeResult (CardanoBlock sc))
-      genQueryAnytimeResult =
-          SomeResult (QueryAnytimeShelley EraStart) <$> arbitrary
+      genQueryAnytimeResultByron :: Gen (SomeResult (CardanoBlock sc))
+      genQueryAnytimeResultByron =
+          SomeResult (QueryAnytimeByron GetEraStart) <$> arbitrary
+
+      genQueryAnytimeResultShelley :: Gen (SomeResult (CardanoBlock sc))
+      genQueryAnytimeResultShelley =
+          SomeResult (QueryAnytimeShelley GetEraStart) <$> arbitrary
+
+      genQueryHardForkResult :: Gen (SomeResult (CardanoBlock sc))
+      genQueryHardForkResult =
+          SomeResult (QueryHardFork GetInterpreter) <$> arbitrary
 
 instance (sc ~ TPraosMockCrypto h, HashAlgorithm h)
       => Arbitrary (MismatchEraInfo (CardanoEras sc)) where
diff --git a/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion1/Result_AnytimeByron b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion1/Result_AnytimeByron
new file mode 100644
index 0000000000..070897ad04
Binary files /dev/null and b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion1/Result_AnytimeByron differ
diff --git a/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion1/Result_HardFork b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion1/Result_HardFork
new file mode 100644
index 0000000000..95c9bfc9cb
Binary files /dev/null and b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion1/Result_HardFork differ
diff --git a/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion2/Result_AnytimeByron b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion2/Result_AnytimeByron
new file mode 100644
index 0000000000..070897ad04
Binary files /dev/null and b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion2/Result_AnytimeByron differ
diff --git a/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion2/Result_HardFork b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion2/Result_HardFork
new file mode 100644
index 0000000000..95c9bfc9cb
Binary files /dev/null and b/ouroboros-consensus-cardano/test/golden/CardanoNodeToClientVersion2/Result_HardFork differ
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/BlockchainTime/WallClock/Types.hs b/ouroboros-consensus/src/Ouroboros/Consensus/BlockchainTime/WallClock/Types.hs
index 2ddcc951eb..dc87cba1db 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/BlockchainTime/WallClock/Types.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/BlockchainTime/WallClock/Types.hs
@@ -142,3 +142,7 @@ instance Serialise RelativeTime where
     where
       fromPico :: Pico -> NominalDiffTime
       fromPico = realToFrac
+
+instance Serialise SlotLength where
+  encode = encode . slotLengthToMillisec
+  decode = slotLengthFromMillisec <$> decode
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
index 8a59080912..9b42991682 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
@@ -202,7 +202,7 @@ getSameValue
   -> a
 getSameValue values =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ ->
+      ProofNonEmpty {} ->
         assertWithMsg allEqualCheck (unK (hd values))
   where
     allEqualCheck :: Either String ()
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Block.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Block.hs
index f66e4e3536..e8eb9b8c78 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Block.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Block.hs
@@ -206,11 +206,11 @@ instance CanHardFork xs => HasAnnTip (HardForkBlock xs) where
 instance CanHardFork xs => BasicEnvelopeValidation (HardForkBlock xs) where
   expectedFirstBlockNo _ =
       case isNonEmpty (Proxy @xs) of
-        ProofNonEmpty p -> expectedFirstBlockNo p
+        ProofNonEmpty p _ -> expectedFirstBlockNo p
 
   minimumPossibleSlotNo _ =
       case isNonEmpty (Proxy @xs) of
-        ProofNonEmpty p -> minimumPossibleSlotNo p
+        ProofNonEmpty p _ -> minimumPossibleSlotNo p
 
   -- TODO: If the block is from a different era as the current tip, we just
   -- expect @succ b@. This may not be sufficient: if we ever transition /to/
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs
index b803f35823..023142b822 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE TypeApplications      #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -182,7 +183,7 @@ instance CanHardFork xs => UpdateLedger (HardForkBlock xs)
   HasHardForkHistory
 -------------------------------------------------------------------------------}
 
-instance CanHardFork xs => HasHardForkHistory (HardForkBlock xs) where
+instance All SingleEraBlock xs => HasHardForkHistory (HardForkBlock xs) where
   type HardForkIndices (HardForkBlock xs) = xs
 
   hardForkSummary cfg = State.reconstructSummaryLedger cfg
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs
index eb3fdbca4f..ba5b485775 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Ledger/Query.hs
@@ -22,10 +22,13 @@ module Ouroboros.Consensus.HardFork.Combinator.Ledger.Query (
   , QueryIfCurrent(..)
   , HardForkQueryResult
   , QueryAnytime(..)
+  , QueryHardFork(..)
   , getHardForkQuery
   , hardForkQueryInfo
   , encodeQueryAnytimeResult
   , decodeQueryAnytimeResult
+  , encodeQueryHardForkResult
+  , decodeQueryHardForkResult
   ) where
 
 import           Codec.CBOR.Decoding (Decoder)
@@ -40,6 +43,7 @@ import           Data.Type.Equality
 
 import           Cardano.Binary (enforceSize)
 
+import           Ouroboros.Consensus.HardFork.Abstract (hardForkSummary)
 import           Ouroboros.Consensus.HardFork.History (Bound (..), EraParams,
                      Shape (..))
 import qualified Ouroboros.Consensus.HardFork.History as History
@@ -60,6 +64,7 @@ import           Ouroboros.Consensus.HardFork.Combinator.Util.Match
 
 instance All SingleEraBlock xs => ShowQuery (Query (HardForkBlock xs)) where
   showResult (QueryAnytime   qry _) result = showResult qry result
+  showResult (QueryHardFork  qry)   result = showResult qry result
   showResult (QueryIfCurrent qry)  mResult =
       case mResult of
         Left  err    -> show err
@@ -76,16 +81,26 @@ instance All SingleEraBlock xs => QueryLedger (HardForkBlock xs) where
 
     -- | Answer a query about an era from /any/ era.
     --
-    -- NOTE: this is restricted to eras other than the first era so that the
+    -- NOTE: we don't allow this when there is only a single era, so that the
     -- HFC applied to a single era is still isomorphic to the single era.
     QueryAnytime ::
-         QueryAnytime result
-      -> EraIndex xs
+         IsNonEmpty xs
+      => QueryAnytime result
+      -> EraIndex (x ': xs)
+      -> Query (HardForkBlock (x ': xs)) result
+
+    -- | Answer a query about the hard fork combinator
+    --
+    -- NOTE: we don't allow this when there is only a single era, so that the
+    -- HFC applied to a single era is still isomorphic to the single era.
+    QueryHardFork ::
+         IsNonEmpty xs
+      => QueryHardFork (x ': xs) result
       -> Query (HardForkBlock (x ': xs)) result
 
   answerQuery hardForkConfig@HardForkLedgerConfig{..}
               query
-              (HardForkLedgerState hardForkState) =
+              st@(HardForkLedgerState hardForkState) =
       case query of
         QueryIfCurrent queryIfCurrent ->
           interpretQueryIfCurrent
@@ -97,22 +112,31 @@ instance All SingleEraBlock xs => QueryLedger (HardForkBlock xs) where
           interpretQueryAnytime
             hardForkConfig
             queryAnytime
-            (EraIndex (S era))
+            (EraIndex era)
             hardForkState
+        QueryHardFork queryHardFork ->
+          interpretQueryHardFork
+            hardForkConfig
+            queryHardFork
+            st
     where
       cfgs = getPerEraLedgerConfig hardForkLedgerConfigPerEra
       ei   = State.epochInfoLedger hardForkConfig hardForkState
 
+  eqQuery (QueryIfCurrent qry) (QueryIfCurrent qry') =
+      apply Refl <$> eqQueryIfCurrent qry qry'
+  eqQuery (QueryIfCurrent {}) _ =
+      Nothing
   eqQuery (QueryAnytime qry era) (QueryAnytime qry' era')
     | era == era'
     = eqQueryAnytime qry qry'
     | otherwise
     = Nothing
-  eqQuery (QueryIfCurrent qry) (QueryIfCurrent qry') =
-      apply Refl <$> eqQueryIfCurrent qry qry'
-  eqQuery (QueryIfCurrent {}) (QueryAnytime {}) =
+  eqQuery (QueryAnytime {}) _ =
       Nothing
-  eqQuery (QueryAnytime {}) (QueryIfCurrent {}) =
+  eqQuery (QueryHardFork qry) (QueryHardFork qry') =
+      eqQueryHardFork qry qry'
+  eqQuery (QueryHardFork {}) _ =
       Nothing
 
 deriving instance All SingleEraBlock xs => Show (Query (HardForkBlock xs) result)
@@ -124,12 +148,20 @@ getHardForkQuery :: Query (HardForkBlock xs) result
                        -> r)
                  -> (forall x' xs'.
                           xs :~: x' ': xs'
+                       -> ProofNonEmpty xs'
                        -> QueryAnytime result
-                       -> EraIndex xs'
+                       -> EraIndex xs
+                       -> r)
+                 -> (forall x' xs'.
+                          xs :~: x' ': xs'
+                       -> ProofNonEmpty xs'
+                       -> QueryHardFork xs result
                        -> r)
                  -> r
-getHardForkQuery (QueryIfCurrent qry) k1 _   = k1 Refl qry
-getHardForkQuery (QueryAnytime qry era) _ k2 = k2 Refl qry era
+getHardForkQuery q k1 k2 k3 = case q of
+    QueryIfCurrent qry   -> k1 Refl qry
+    QueryAnytime qry era -> k2 Refl (isNonEmpty Proxy) qry era
+    QueryHardFork qry    -> k3 Refl (isNonEmpty Proxy) qry
 
 {-------------------------------------------------------------------------------
   Current era queries
@@ -182,18 +214,18 @@ interpretQueryIfCurrent ei = go
 -------------------------------------------------------------------------------}
 
 data QueryAnytime result where
-  EraStart :: QueryAnytime (Maybe Bound)
+  GetEraStart :: QueryAnytime (Maybe Bound)
 
 deriving instance Show (QueryAnytime result)
 
 instance ShowQuery QueryAnytime where
-  showResult EraStart = show
+  showResult GetEraStart = show
 
 eqQueryAnytime ::
      QueryAnytime result
   -> QueryAnytime result'
   -> Maybe (result :~: result')
-eqQueryAnytime EraStart EraStart = Just Refl
+eqQueryAnytime GetEraStart GetEraStart = Just Refl
 
 interpretQueryAnytime ::
      forall result xs. All SingleEraBlock xs
@@ -222,9 +254,9 @@ answerQueryAnytime HardForkLedgerConfig{..} =
        -> QueryAnytime result
        -> Situated h LedgerState xs'
        -> result
-    go Nil       _             _        ctxt = case ctxt of {}
-    go (c :* cs) (K ps :* pss) EraStart ctxt = case ctxt of
-      SituatedShift ctxt'   -> go cs pss EraStart ctxt'
+    go Nil       _             _           ctxt = case ctxt of {}
+    go (c :* cs) (K ps :* pss) GetEraStart ctxt = case ctxt of
+      SituatedShift ctxt'   -> go cs pss GetEraStart ctxt'
       SituatedFuture _ _    -> Nothing
       SituatedPast past _   -> Just $ pastStart past
       SituatedCurrent cur _ -> Just $ currentStart cur
@@ -236,12 +268,40 @@ answerQueryAnytime HardForkLedgerConfig{..} =
           (currentStart cur)
           (currentState cur)
 
+{-------------------------------------------------------------------------------
+  Hard fork queries
+-------------------------------------------------------------------------------}
+
+data QueryHardFork xs result where
+  GetInterpreter :: QueryHardFork xs (History.Interpreter xs)
+
+deriving instance Show (QueryHardFork xs result)
+
+instance ShowQuery (QueryHardFork xs) where
+  showResult GetInterpreter = show
+
+eqQueryHardFork ::
+     QueryHardFork xs result
+  -> QueryHardFork xs result'
+  -> Maybe (result :~: result')
+eqQueryHardFork GetInterpreter GetInterpreter = Just Refl
+
+interpretQueryHardFork ::
+     All SingleEraBlock xs
+  => HardForkLedgerConfig xs
+  -> QueryHardFork xs result
+  -> LedgerState (HardForkBlock xs)
+  -> result
+interpretQueryHardFork cfg query st =
+    case query of
+      GetInterpreter -> History.mkInterpreter $ hardForkSummary cfg st
+
 {-------------------------------------------------------------------------------
   Serialisation
 -------------------------------------------------------------------------------}
 
 instance Serialise (Some QueryAnytime) where
-  encode (Some EraStart) = mconcat [
+  encode (Some GetEraStart) = mconcat [
         Enc.encodeListLen 1
       , Enc.encodeWord8 0
       ]
@@ -250,14 +310,37 @@ instance Serialise (Some QueryAnytime) where
     enforceSize "QueryAnytime" 1
     tag <- Dec.decodeWord8
     case tag of
-      0 -> return $ Some EraStart
+      0 -> return $ Some GetEraStart
       _ -> fail $ "QueryAnytime: invalid tag " ++ show tag
 
 encodeQueryAnytimeResult :: QueryAnytime result -> result -> Encoding
-encodeQueryAnytimeResult EraStart = encode
+encodeQueryAnytimeResult GetEraStart = encode
 
 decodeQueryAnytimeResult :: QueryAnytime result -> forall s. Decoder s result
-decodeQueryAnytimeResult EraStart = decode
+decodeQueryAnytimeResult GetEraStart = decode
+
+encodeQueryHardForkResult ::
+     SListI xs
+  => QueryHardFork xs result -> result -> Encoding
+encodeQueryHardForkResult GetInterpreter = encode
+
+decodeQueryHardForkResult ::
+     SListI xs
+  => QueryHardFork xs result -> forall s. Decoder s result
+decodeQueryHardForkResult GetInterpreter = decode
+
+instance Serialise (Some (QueryHardFork xs)) where
+  encode (Some GetInterpreter) = mconcat [
+        Enc.encodeListLen 1
+      , Enc.encodeWord8 0
+      ]
+
+  decode = do
+    enforceSize "QueryHardFork" 1
+    tag <- Dec.decodeWord8
+    case tag of
+      0 -> return $ Some GetInterpreter
+      _ -> fail $ "QueryHardFork: invalid tag " ++ show tag
 
 {-------------------------------------------------------------------------------
   Auxiliary
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs
index d4d71016fa..b0caf9ba83 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToClient.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE EmptyCase             #-}
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
@@ -36,6 +37,7 @@ import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.Node.Serialisation
 import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Consensus.Util ((.:))
+import           Ouroboros.Consensus.Util.SOP (checkIsNonEmpty)
 
 instance SerialiseHFC xs => SerialiseNodeToClientConstraints (HardForkBlock xs)
 
@@ -53,7 +55,7 @@ dispatchEncoder :: forall f xs. (
                 -> NS f xs -> Encoding
 dispatchEncoder ccfg version ns =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ ->
+      ProofNonEmpty {} ->
         case (ccfgs, version, ns) of
           (c0 :* _, HardForkNodeToClientDisabled v0, Z x0) ->
             encodeNodeToClient c0 (unwrapNodeToClientVersion v0) x0
@@ -80,7 +82,7 @@ dispatchDecoder :: forall f xs. (
                 -> forall s. Decoder s (NS f xs)
 dispatchDecoder ccfg version =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ ->
+      ProofNonEmpty {} ->
         case (ccfgs, version) of
           (c0 :* _, HardForkNodeToClientDisabled v0) ->
             Z <$> decodeNodeToClient c0 (unwrapNodeToClientVersion v0)
@@ -162,25 +164,45 @@ instance SerialiseHFC xs
       => SerialiseNodeToClient (HardForkBlock xs) (SomeBlock Query (HardForkBlock xs)) where
   encodeNodeToClient ccfg version (SomeBlock q) = case q of
       QueryIfCurrent qry -> mconcat [
-            Enc.encodeListLen 1
+            Enc.encodeListLen 2
+          , Enc.encodeWord8 0
           , dispatchEncoder ccfg version (distribQueryIfCurrent (Some qry))
           ]
       QueryAnytime qry eraIndex -> mconcat [
-            Enc.encodeListLen 2
+            Enc.encodeListLen 3
+          , Enc.encodeWord8 1
           , Serialise.encode (Some qry)
           , Serialise.encode eraIndex
           ]
+      QueryHardFork qry -> mconcat [
+            Enc.encodeListLen 2
+          , Enc.encodeWord8 2
+          , Serialise.encode (Some qry)
+          ]
 
   decodeNodeToClient ccfg version = case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ -> do
+      ProofNonEmpty (_ :: Proxy x') (p :: Proxy xs') -> do
         size <- Dec.decodeListLen
-        case size of
-          1 -> injQueryIfCurrent <$> dispatchDecoder ccfg version
-          2 -> do
-            Some qry <- Serialise.decode
-            eraIndex <- Serialise.decode
-            return $ SomeBlock (QueryAnytime qry eraIndex)
-          _ -> fail $ "HardForkQuery: invalid listLen" <> show size
+        tag  <- Dec.decodeWord8
+        case (size, tag) of
+          (2, 0) -> injQueryIfCurrent <$> dispatchDecoder ccfg version
+
+          (3, 1) -> do
+            Some (qry :: QueryAnytime result) <- Serialise.decode
+            eraIndex :: EraIndex (x' ': xs')  <- Serialise.decode
+            case checkIsNonEmpty p of
+              Nothing -> fail $ "QueryAnytime requires multiple era"
+              Just (ProofNonEmpty {}) ->
+                return $ SomeBlock (QueryAnytime qry eraIndex)
+
+          (2, 2) -> do
+            Some (qry :: QueryHardFork xs result) <- Serialise.decode
+            case checkIsNonEmpty p of
+              Nothing -> fail $ "QueryHardFork requires multiple era"
+              Just (ProofNonEmpty {}) ->
+                return $ SomeBlock (QueryHardFork qry)
+
+          _ -> fail $ "HardForkQuery: invalid size and tag" <> show (size, tag)
     where
       injQueryIfCurrent :: NS (SomeBlock Query) xs
                         -> SomeBlock Query (HardForkBlock xs)
@@ -196,7 +218,7 @@ instance SerialiseHFC xs
       => SerialiseResult (HardForkBlock xs) (Query (HardForkBlock xs)) where
   encodeResult ccfg version (QueryIfCurrent qry) =
       case isNonEmpty (Proxy @xs) of
-        ProofNonEmpty _ ->
+        ProofNonEmpty {} ->
           encodeEitherMismatch version $
             case (ccfgs, version, qry) of
               (c0 :* _, HardForkNodeToClientDisabled v0, QZ qry') ->
@@ -209,10 +231,11 @@ instance SerialiseHFC xs
       ccfgs = getPerEraCodecConfig $ hardForkCodecConfigPerEra ccfg
 
   encodeResult _ _ (QueryAnytime qry _) = encodeQueryAnytimeResult qry
+  encodeResult _ _ (QueryHardFork qry)  = encodeQueryHardForkResult qry
 
   decodeResult ccfg version (QueryIfCurrent qry) =
       case isNonEmpty (Proxy @xs) of
-        ProofNonEmpty _ ->
+        ProofNonEmpty {} ->
           decodeEitherMismatch version $
             case (ccfgs, version, qry) of
               (c0 :* _, HardForkNodeToClientDisabled v0, QZ qry') ->
@@ -225,6 +248,7 @@ instance SerialiseHFC xs
       ccfgs = getPerEraCodecConfig $ hardForkCodecConfigPerEra ccfg
 
   decodeResult _ _ (QueryAnytime qry _) = decodeQueryAnytimeResult qry
+  decodeResult _ _ (QueryHardFork qry)  = decodeQueryHardForkResult qry
 
 encodeQueryIfCurrentResult ::
      All SerialiseConstraintsHFC xs
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToNode.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToNode.hs
index 8696c5f3e8..303c5052c4 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToNode.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Serialisation/SerialiseNodeToNode.hs
@@ -54,7 +54,7 @@ dispatchEncoder :: forall f xs. (
                 -> NS f xs -> Encoding
 dispatchEncoder ccfg version ns =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ ->
+      ProofNonEmpty {} ->
         case (ccfgs, version, ns) of
           (c0 :* _, HardForkNodeToNodeDisabled v0, Z x0) ->
             encodeNodeToNode c0 (unwrapNodeToNodeVersion v0) x0
@@ -81,7 +81,7 @@ dispatchDecoder :: forall f xs. (
                 -> forall s. Decoder s (NS f xs)
 dispatchDecoder ccfg version =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ ->
+      ProofNonEmpty {} ->
         case (ccfgs, version) of
           (c0 :* _, HardForkNodeToNodeDisabled v0) ->
             Z <$> decodeNodeToNode c0 (unwrapNodeToNodeVersion v0)
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/State.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/State.hs
index f2287ba445..b73a51e194 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/State.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/State.hs
@@ -67,7 +67,7 @@ recover :: forall g f xs. CanHardFork xs
         => Telescope (Past g) f xs -> HardForkState_ g f xs
 recover =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ ->
+      ProofNonEmpty {} ->
           HardForkState
         . Telescope.bihmap
             (\(Pair _ past) -> past)
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Unary.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Unary.hs
index b2348c60cd..c682480323 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Unary.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Unary.hs
@@ -535,7 +535,8 @@ projQuery qry k =
     getHardForkQuery
       qry
       (\Refl -> k Refl . aux)
-      (\Refl _ eraIndex -> absurd $ emptyEraIndex eraIndex)
+      (\Refl prfNonEmpty _ _ -> case prfNonEmpty of {})
+      (\Refl prfNonEmpty _   -> case prfNonEmpty of {})
   where
     aux :: QueryIfCurrent '[b] result -> Query b result
     aux (QZ q) = q
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Util/InPairs.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Util/InPairs.hs
index b311ba38f2..52ff527ac7 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Util/InPairs.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/Combinator/Util/InPairs.hs
@@ -60,7 +60,7 @@ hcpure :: forall proxy c xs f. (All c xs, IsNonEmpty xs)
        -> (forall x y. (c x, c y) => f x y) -> InPairs f xs
 hcpure _ f =
     case isNonEmpty (Proxy @xs) of
-      ProofNonEmpty _ -> go sList
+      ProofNonEmpty {} -> go sList
   where
     go :: (c x, All c xs') => SList xs' -> InPairs f (x ': xs')
     go SNil  = PNil
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/EraParams.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/EraParams.hs
index 2679b5a611..cea96e15a2 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/EraParams.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/EraParams.hs
@@ -1,6 +1,9 @@
 {-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase         #-}
+{-# LANGUAGE OverloadedStrings  #-}
+{-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE TypeOperators      #-}
 
 module Ouroboros.Consensus.HardFork.History.EraParams (
@@ -15,9 +18,13 @@ module Ouroboros.Consensus.HardFork.History.EraParams (
   , maxMaybeEpoch
   ) where
 
+import           Codec.CBOR.Decoding (decodeListLen, decodeWord8)
+import           Codec.CBOR.Encoding (encodeListLen, encodeWord8)
+import           Codec.Serialise (Serialise (..))
 import           Data.Word
 import           GHC.Generics (Generic)
 
+import           Cardano.Binary (enforceSize)
 import           Cardano.Prelude (NoUnexpectedThunks)
 
 import           Ouroboros.Consensus.Block
@@ -218,3 +225,49 @@ maxMaybeEpoch :: SafeBeforeEpoch -> EpochNo -> Maybe EpochNo
 maxMaybeEpoch NoLowerBound    e = Just $ e
 maxMaybeEpoch (LowerBound e') e = Just $ max e' e
 maxMaybeEpoch UnsafeUnbounded _ = Nothing
+
+{-------------------------------------------------------------------------------
+  Serialisation
+-------------------------------------------------------------------------------}
+
+instance Serialise SafeBeforeEpoch where
+  encode = \case
+      NoLowerBound    -> encodeListLen 1 <> encodeWord8 0
+      LowerBound e    -> encodeListLen 2 <> encodeWord8 1 <> encode e
+      UnsafeUnbounded -> encodeListLen 1 <> encodeWord8 2
+  decode = do
+      size <- decodeListLen
+      tag  <- decodeWord8
+      case (size, tag) of
+        (1, 0) -> return NoLowerBound
+        (2, 1) -> LowerBound <$> decode
+        (1, 2) -> return UnsafeUnbounded
+        _      -> fail $ "SafeBeforeEpoch: invalid size and tag " <> show (size, tag)
+
+instance Serialise SafeZone where
+  encode SafeZone{..} = mconcat [
+        encodeListLen 2
+      , encode safeFromTip
+      , encode safeBeforeEpoch
+      ]
+
+  decode = do
+      enforceSize "SafeZone" 2
+      safeFromTip     <- decode
+      safeBeforeEpoch <- decode
+      return SafeZone{..}
+
+instance Serialise EraParams where
+  encode EraParams{..} = mconcat [
+        encodeListLen 3
+      , encode (unEpochSize eraEpochSize)
+      , encode eraSlotLength
+      , encode eraSafeZone
+      ]
+
+  decode = do
+      enforceSize "EraParams" 3
+      eraEpochSize  <- EpochSize <$> decode
+      eraSlotLength <- decode
+      eraSafeZone   <- decode
+      return EraParams{..}
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Qry.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Qry.hs
index fd268c1258..23a5ef5702 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Qry.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Qry.hs
@@ -1,12 +1,20 @@
-{-# LANGUAGE GADTs           #-}
-{-# LANGUAGE KindSignatures  #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 module Ouroboros.Consensus.HardFork.History.Qry (
     Qry(..)
   , runQuery
   , runQueryThrow
   , runQueryPure
+    -- * Interpreter
+  , Interpreter -- opaque
+  , mkInterpreter
+  , interpretQuery
     -- * Specific queries
   , wallclockToSlot
   , slotToWallclock
@@ -16,11 +24,13 @@ module Ouroboros.Consensus.HardFork.History.Qry (
   , epochToSlot
   ) where
 
+import           Codec.Serialise (Serialise (..))
 import           Control.Exception (throw)
 import           Control.Monad.Except
 import           Data.Bifunctor
 import           Data.Fixed (divMod')
 import           Data.Foldable (asum, toList)
+import           Data.SOP.Strict (SListI)
 import           Data.Time hiding (UTCTime)
 import           Data.Word
 import           GHC.Stack
@@ -265,6 +275,32 @@ runQueryThrow q = either throwM return . runQuery q
 runQueryPure :: HasCallStack => Qry a -> Summary xs -> a
 runQueryPure q = either throw id . runQuery q
 
+{-------------------------------------------------------------------------------
+  Interpreter
+-------------------------------------------------------------------------------}
+
+-- | Can be sent across the LocalStateQuery protocol to interpret queries in
+-- the wallet.
+--
+-- The 'Summary' should be considered internal.
+newtype Interpreter xs = Interpreter (Summary xs)
+  deriving (Eq)
+
+deriving instance SListI xs => Serialise (Interpreter xs)
+
+instance Show (Interpreter xs) where
+  show _ = "<Interpreter>"
+
+mkInterpreter :: Summary xs -> Interpreter xs
+mkInterpreter = Interpreter
+
+interpretQuery ::
+     HasCallStack
+  => Interpreter xs
+  -> Qry a
+  -> Either PastHorizonException a
+interpretQuery (Interpreter summary) qry = runQuery qry summary
+
 {-------------------------------------------------------------------------------
   Specific queries
 
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Summary.hs b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Summary.hs
index e2fd9657d1..df5d68ecef 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Summary.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Summary.hs
@@ -3,15 +3,18 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE KindSignatures             #-}
+{-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 module Ouroboros.Consensus.HardFork.History.Summary (
     -- * Bounds
@@ -42,7 +45,9 @@ module Ouroboros.Consensus.HardFork.History.Summary (
   , summaryInit
   ) where
 
-import           Codec.CBOR.Encoding (encodeListLen)
+import           Codec.CBOR.Decoding (TokenType (TypeNull), decodeNull,
+                     peekTokenType)
+import           Codec.CBOR.Encoding (encodeListLen, encodeNull)
 import           Codec.Serialise
 import           Control.Exception (Exception)
 import           Control.Monad.Except
@@ -50,7 +55,7 @@ import           Data.Bifunctor
 import           Data.Foldable (toList)
 import           Data.Proxy
 import           Data.SOP.Dict (Dict (..))
-import           Data.SOP.Strict (K (..), NP (..))
+import           Data.SOP.Strict (K (..), NP (..), SListI, lengthSList)
 import           Data.Time hiding (UTCTime)
 import           Data.Word
 import           GHC.Generics (Generic)
@@ -193,7 +198,7 @@ data EraEnd =
 
 -- We have at most one summary for each era, and at least one
 newtype Summary xs = Summary (NonEmpty xs EraSummary)
-  deriving (Show)
+  deriving (Eq, Show)
 
 -- WHNF is sufficient, because the counting types are all strict
 deriving via UseIsNormalFormNamed "Summary" (Summary xs)
@@ -502,3 +507,38 @@ instance Serialise Bound where
       boundSlot  <- decode
       boundEpoch <- decode
       return Bound{..}
+
+instance Serialise EraEnd where
+  encode EraUnbounded   = encodeNull
+  encode (EraEnd bound) = encode bound
+
+  decode = peekTokenType >>= \case
+      TypeNull -> do
+        decodeNull
+        return EraUnbounded
+      _ -> EraEnd <$> decode
+
+instance Serialise EraSummary where
+  encode EraSummary{..} = mconcat [
+        encodeListLen 3
+      , encode eraStart
+      , encode eraEnd
+      , encode eraParams
+      ]
+
+  decode = do
+      enforceSize "EraSummary" 3
+      eraStart  <- decode
+      eraEnd    <- decode
+      eraParams <- decode
+      return EraSummary{..}
+
+instance SListI xs => Serialise (Summary xs) where
+  encode (Summary eraSummaries) = encode (toList eraSummaries)
+  decode = do
+      eraSummaries <- decode
+      case Summary <$> nonEmptyFromList eraSummaries of
+        Just summary -> return summary
+        Nothing      -> fail $
+          "Summary: expected between 1 and " <> show (lengthSList (Proxy @xs)) <>
+          " eras but got " <> show (length eraSummaries)
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Util/Counting.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Util/Counting.hs
index 53b9e7b807..3c339c493f 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Util/Counting.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Util/Counting.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveFoldable      #-}
 {-# LANGUAGE DeriveFunctor       #-}
 {-# LANGUAGE DeriveTraversable   #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE FlexibleInstances   #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE KindSignatures      #-}
@@ -9,6 +10,7 @@
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving  #-}
+{-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE TypeOperators       #-}
 
 -- | Type-level counting
@@ -39,6 +41,7 @@ module Ouroboros.Consensus.Util.Counting (
   , nonEmptyHead
   , nonEmptyLast
   , nonEmptyInit
+  , nonEmptyFromList
   ) where
 
 import qualified Data.Foldable as Foldable
@@ -62,6 +65,9 @@ data NonEmpty :: [*] -> * -> * where
   NonEmptyOne  :: !a -> NonEmpty (x ': xs) a
   NonEmptyCons :: !a -> !(NonEmpty xs a) -> NonEmpty (x ': xs) a
 
+deriving instance Eq a => Eq (AtMost   xs a)
+deriving instance Eq a => Eq (NonEmpty xs a)
+
 deriving instance Show a => Show (AtMost   xs a)
 deriving instance Show a => Show (NonEmpty xs a)
 
@@ -199,3 +205,15 @@ nonEmptyInit (NonEmptyCons x xs) =
     case nonEmptyInit xs of
       (Nothing  , final) -> (Just (NonEmptyOne  x)     , final)
       (Just xs' , final) -> (Just (NonEmptyCons x xs') , final)
+
+-- | Build a 'NonEmpty' from a list. Returns 'Nothing' when the list is empty
+-- or when it's longer than @xs@.
+nonEmptyFromList :: forall xs a. SListI xs => [a] -> Maybe (NonEmpty xs a)
+nonEmptyFromList = go (sList @xs)
+  where
+    go :: forall xs'. SList xs' -> [a] -> Maybe (NonEmpty xs' a)
+    go s ys = case (s, ys) of
+        (SCons, [y])   -> Just $ NonEmptyOne y
+        (SCons, y:ys') -> NonEmptyCons y <$> go sList ys'
+        (SCons, [])    -> Nothing
+        (SNil,  _)     -> Nothing
diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Util/SOP.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Util/SOP.hs
index 1e58069d67..d5d7d4b87c 100644
--- a/ouroboros-consensus/src/Ouroboros/Consensus/Util/SOP.hs
+++ b/ouroboros-consensus/src/Ouroboros/Consensus/Util/SOP.hs
@@ -27,6 +27,7 @@ module Ouroboros.Consensus.Util.SOP (
     -- * Type-level non-empty lists
   , IsNonEmpty(..)
   , ProofNonEmpty(..)
+  , checkIsNonEmpty
     -- * NP with optional values
   , OptNP(..)
   , fromOptNP
@@ -157,13 +158,18 @@ fn_5 f = Fn $ \x0 ->
 -------------------------------------------------------------------------------}
 
 data ProofNonEmpty :: [*] -> * where
-  ProofNonEmpty :: Proxy x -> ProofNonEmpty (x ': xs)
+  ProofNonEmpty :: Proxy x -> Proxy xs -> ProofNonEmpty (x ': xs)
 
 class IsNonEmpty xs where
   isNonEmpty :: proxy xs -> ProofNonEmpty xs
 
 instance IsNonEmpty (x ': xs) where
-  isNonEmpty _ = ProofNonEmpty (Proxy @x)
+  isNonEmpty _ = ProofNonEmpty (Proxy @x) (Proxy @xs)
+
+checkIsNonEmpty :: forall xs. SListI xs => Proxy xs -> Maybe (ProofNonEmpty xs)
+checkIsNonEmpty _ = case sList @xs of
+    SNil  -> Nothing
+    SCons -> Just $ ProofNonEmpty Proxy Proxy
 
 {-------------------------------------------------------------------------------
   NP with optional values