Gracefully handle decoding more summaries than statically known eras

Old wallets (or other clients) that are only aware of Byron and Shelley should
be able to communicate with nodes until the hard fork to Allegra actually takes
place. At that moment, they will stop functioning as they don't know about
Allegra. The `NodeToClient` versioning mechanism takes care of this.

However, we have noticed that when the update proposal for Allegra becomes
stable, the old clients' `Summary` decoder starts to fail with:

    Summary: expected between 1 and 2 eras but got 3

This is because after the update proposal for Allegra has become stable, the
node (which is compatible with Allegra) will extend its `Summary` with an
`EraSummary` of the Allegra era. The `Summary` decoder of the old client does
not support more `EraSummary`s (3) than eras it is aware of (2) and fails. This
is /before/ the hard fork has actually happened. While the window between this
and the actual hard fork, at which point the old client would stop functioning
anyway, is small, it would still be nicer if this were handled gracefully.

So instead of failing when we receive more `EraSummary`s than eras we statically
are aware of, we ignore them. For example, a client that thinks Shelley is the
final era will ignore the `EraSummary` of Allegra (and Mary) and will keep
acting as if Shelley is the final era. Of course, when the hard fork to the next
era actually happens, the client will stop functioning as before.

Note that this fix is too late for the upcoming Allegra hard fork: only clients
that haven't been upgraded to the last release will run into this problem.
Upgrading them to the next release that includes this fix already makes the
problem go away, as they will gain support for Allegra (and Mary).

This fix will thus only help the next time, i.e., when clients are running a
version that supports Allegra and Mary (and includes this fix) but not the era
after that, i.e., Alonzo, and the update proposal to Alonzo has become stable.

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

@@ -29,7 +29,7 @@ import Ouroboros.Consensus.Node.NetworkProtocolVersion
 import Ouroboros.Consensus.Node.Serialisation (Some (..))
 import Ouroboros.Consensus.TypeFamilyWrappers
 import Ouroboros.Consensus.Util.Counting (NonEmpty (..),
- nonEmptyFromList)
+ nonEmptyFromList, nonEmptyToList)
 import Ouroboros.Consensus.Util.SOP (nsFromIndex)
 
 import Ouroboros.Consensus.HardFork.Combinator
@@ -432,7 +432,23 @@ instance (Arbitrary a, SListI xs) => Arbitrary (NonEmpty xs a) where
  return $ fromMaybe (error "nonEmptyFromList failed") $ nonEmptyFromList xs
 
 instance Arbitrary (History.Interpreter (CardanoEras c)) where
- arbitrary = History.mkInterpreter . History.Summary <$> arbitrary
+ arbitrary =
+ History.mkInterpreter . History.Summary . enforceInvariant <$> arbitrary
+ where
+ -- Enforce the invariant that when the last era in the summary is the
+ -- final era, it is unbounded. The decoder relies on this.
+ enforceInvariant xs
+ | length (nonEmptyToList xs) == lengthSList (Proxy @(CardanoEras c))
+ = fixEndBound xs
+ | otherwise
+ = xs
+
+ fixEndBound ::
+ NonEmpty xs History.EraSummary
+ -> NonEmpty xs History.EraSummary
+ fixEndBound (NonEmptyCons e es) = NonEmptyCons e (fixEndBound es)
+ fixEndBound (NonEmptyOne e) =
+ NonEmptyOne e { History.eraEnd = History.EraUnbounded }
 
 instance Arbitrary (EraIndex (CardanoEras c)) where
  arbitrary = do

ouroboros-consensus/src/Ouroboros/Consensus/HardFork/History/Summary.hs

@@ -193,7 +193,7 @@ data EraEnd =
 --
 -- The summary zips 'Shape' with 'Forks', and provides detailed information
 -- about the start and end of each era.
-
+--
 -- We have at most one summary for each era, and at least one
 newtype Summary xs = Summary { getSummary :: NonEmpty xs EraSummary }
  deriving (Eq, Show)
@@ -492,10 +492,83 @@ instance Serialise EraSummary where
 
 instance SListI xs => Serialise (Summary xs) where
  encode (Summary eraSummaries) = encode (toList eraSummaries)
+
+ -- @xs@ is the list of eras that is statically known to us; the server has a
+ -- similar list @ys@ of eras that /it/ statically knows about. We do not know
+ -- what @ys@ is here, but we can nonetheless reason about how @|xs|@ and
+ -- @|ys|@ might relate:
+ --
+ -- - @|xs| == |ys|@: this is the normal case; we and the server know about the
+ -- same (number of) eras. No special care needs to be taken.
+ --
+ -- - @|xs| > |ys|@: we know about more eras than the server does. The server
+ -- will send us era summaries for @1 <= n <= |ys|@ eras. For sure @n <
+ -- |xs|@, so decoding will be unproblematic. The only slightly strange case
+ -- is when @n == |ys|@: in this case, the server thinks we are in the final
+ -- era, whereas in fact that era isn't actually final; consequently, the
+ -- server will give us an unbounded summary for that "final" era. However,
+ -- if we are following that particular server, treating that era as
+ -- unbounded is okay, since we anyway won't be transitioning to the next
+ -- era.
+ --
+ -- [TODO: Won't we be making any decisions that we might regret if we do
+ -- eventually switch server..?]
+ --
+ -- - @|xs| < |ys|@: we know about fewer eras than the server does. This will
+ -- happen when the server has been upgraded for the next hard fork, but the
+ -- client hasn't yet. Pattern match on the number @n@ of eras that the
+ -- server sends us summaries for:
+ --
+ -- o @n < |xs|@: Although the server knows about more eras than us, they
+ -- actually only send us era summaries for fewer eras than we know about.
+ -- This means that the transition to what _we_ believe is the final era is
+ -- not yet known; the summary sent to us by the server is fine as is.
+ --
+ -- o @n == |xs|@: The server does not yet know about the transition out of
+ -- what (we believe to be) the final era. In principle we could decide to
+ -- leave the era summaries as-is; however, since _we_ consider that era to
+ -- be the final one, we should regard it as unbounded (it does not make
+ -- sense to have a bounded final era). We must therefore modify the final
+ -- era summary. Of course this will mean that we will make some incorrect
+ -- decisions; but as long as we aren't updated, we will anyway be unable
+ -- to deal with the next era.
+ --
+ -- o @n > |xs|@: the server already knows about the transition to the next
+ -- era after our final era. In this case we must drop all eras that we
+ -- don't know about, and then modify again the final era to be unbounded,
+ -- just like in the case above.
+ --
+ -- Since we do not know @|ys|@, we cannot actually implement the outermost
+ -- case statement. However:
+ --
+ -- - If @|xs| > |ys|@, by definition @n < |xs|@, and hence we will not modify
+ -- the era summary: this is what we wanted.
+ --
+ -- - If @|xs| == |ys|@, then at most @n == |xs|@, in which case we might
+ -- "modify" the final era to be unbounded. But in this case, the server will
+ -- consider that era to be final as well, and so it will _already_ be
+ -- unbounded: effectively this means that this means we will leave the
+ -- summary unchanged.
  decode = do
- eraSummaries <- decode
- case Summary <$> nonEmptyFromList eraSummaries of
+ -- Drop all eras we don't know about
+ eraSummaries <- take nbXs <$> decode
+
+ let n = length eraSummaries
+ go
+ -- @n == |xs|@
+ | n == nbXs = fixEndBound
+ -- @n < |xs|@
+ | otherwise = id
+
+ case Summary . go <$> nonEmptyFromList eraSummaries of
  Just summary -> return summary
- Nothing -> fail $
- "Summary: expected between 1 and " <> show (lengthSList (Proxy @xs)) <>
- " eras but got " <> show (length eraSummaries)
+ Nothing -> fail "Summary: expected at least one era summary"
+ where
+ -- @|xs|@
+ nbXs :: Int
+ nbXs = lengthSList (Proxy @xs)
+
+ -- | Make the last era's end bound unbounded.
+ fixEndBound :: NonEmpty xs' EraSummary -> NonEmpty xs' EraSummary
+ fixEndBound (NonEmptyCons e es) = NonEmptyCons e (fixEndBound es)
+ fixEndBound (NonEmptyOne e) = NonEmptyOne e { eraEnd = EraUnbounded }

ouroboros-consensus/src/Ouroboros/Consensus/Util/Counting.hs

@@ -45,6 +45,7 @@ module Ouroboros.Consensus.Util.Counting (
  , nonEmptyLast
  , nonEmptyInit
  , nonEmptyFromList
+ , nonEmptyToList
  , nonEmptyWeaken
  , nonEmptyStrictPrefixes
  , nonEmptyMapOne
@@ -310,6 +311,14 @@ nonEmptyFromList = go (sList @xs)
  (SCons, []) -> Nothing
  (SNil, _) -> Nothing
 
+-- | Convert a 'NonEmpty' to a list.
+nonEmptyToList :: forall xs a. NonEmpty xs a -> [a]
+nonEmptyToList = go
+ where
+ go :: forall xs'. NonEmpty xs' a -> [a]
+ go (NonEmptyOne x) = x : []
+ go (NonEmptyCons x xs) = x : go xs
+
 nonEmptyWeaken :: NonEmpty xs a -> AtMost xs a
 nonEmptyWeaken = go
  where