More compact encoding of the overlay schedule

Fixes #1374.
IntersectMBO · Apr 17, 2020 · 1f6fbe3 · 1f6fbe3
1 parent b0f4b02
commit 1f6fbe3
Showing 1 changed file with 29 additions and 3 deletions.
diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/LedgerState.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/LedgerState.hs
@@ -83,6 +83,8 @@ import           Cardano.Crypto.Hash (byteCount)
 import           Cardano.Prelude (NoUnexpectedThunks (..))
 import           Control.Monad.Trans.Reader (ReaderT (..), asks)
 import           Data.Foldable (toList)
+import           Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Proxy (Proxy (..))
@@ -395,7 +397,7 @@ instance Crypto crypto => FromCBOR (UTxOState crypto)
 data OBftSlot crypto =
     NonActiveSlot
   | ActiveSlot !(GenKeyHash crypto)
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Ord, Generic)
 
 instance Crypto crypto
   => ToCBOR (OBftSlot crypto)
@@ -433,7 +435,7 @@ instance Crypto crypto => ToCBOR (NewEpochState crypto)
  where
   toCBOR (NewEpochState e bp bc es ru pd os) =
     encodeListLen 7 <> toCBOR e <> toCBOR bp <> toCBOR bc <> toCBOR es
-      <> toCBOR ru <> toCBOR pd <> toCBOR os
+      <> toCBOR ru <> toCBOR pd <> toCBOR (compactOverlaySchedule os)
 
 instance Crypto crypto => FromCBOR (NewEpochState crypto)
  where
@@ -445,9 +447,33 @@ instance Crypto crypto => FromCBOR (NewEpochState crypto)
     es <- fromCBOR
     ru <- fromCBOR
     pd <- fromCBOR
-    os <- fromCBOR
+    os <- decompactOverlaySchedule <$> fromCBOR
     pure $ NewEpochState e bp bc es ru pd os
 
+-- | Convert the overlay schedule to a representation that is more compact
+-- when serialised to a bytestring, but less efficient for lookups.
+--
+-- Each genesis key hash will only be stored once, instead of each time it is
+-- assigned to a slot.
+compactOverlaySchedule
+  :: Map SlotNo (OBftSlot crypto)
+  -> Map (OBftSlot crypto) (NonEmpty SlotNo)
+compactOverlaySchedule =
+    Map.foldrWithKey'
+      (\slot obftSlot ->
+        Map.insertWith (<>) obftSlot (pure slot))
+      Map.empty
+
+-- | Inverse of 'compactOverlaySchedule'
+decompactOverlaySchedule
+  :: Map (OBftSlot crypto) (NonEmpty SlotNo)
+  -> Map SlotNo (OBftSlot crypto)
+decompactOverlaySchedule compact = Map.fromList
+    [ (slot, obftSlot)
+    | (obftSlot, slots) <- Map.toList compact
+    , slot <- NonEmpty.toList slots
+    ]
+
 getGKeys
   :: NewEpochState crypto
   -> Set (GenKeyHash crypto)