Bump LedgerPeerSnapshot version due to instance changes

IntersectMBO · Jan 17, 2025 · 7242407 · 7242407
1 parent fa432a8
commit 7242407
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 20 deletions.
diff --git a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs
@@ -64,7 +64,7 @@ newtype MinBigLedgerPeersForTrustedState =
 -- to connect to when syncing.
 --
 data LedgerPeerSnapshot =
-  LedgerPeerSnapshotV1 (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
+  LedgerPeerSnapshotV2 (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
   -- ^ Internal use for version 1, use pattern synonym for public API
   deriving (Eq, Show)
 
@@ -74,8 +74,8 @@ data LedgerPeerSnapshot =
 --
 pattern LedgerPeerSnapshot :: (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
                            -> LedgerPeerSnapshot
-pattern LedgerPeerSnapshot payload <- LedgerPeerSnapshotV1 payload where
-  LedgerPeerSnapshot payload = LedgerPeerSnapshotV1 payload
+pattern LedgerPeerSnapshot payload <- LedgerPeerSnapshotV2 payload where
+  LedgerPeerSnapshot payload = LedgerPeerSnapshotV2 payload
 
 {-# COMPLETE LedgerPeerSnapshot #-}
 
@@ -104,11 +104,11 @@ compareLedgerPeerSnapshotApproximate baseline candidate =
 --
 migrateLedgerPeerSnapshot :: LedgerPeerSnapshot
                           -> Maybe (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))])
-migrateLedgerPeerSnapshot (LedgerPeerSnapshotV1 lps) = Just lps
+migrateLedgerPeerSnapshot (LedgerPeerSnapshotV2 lps) = Just lps
 
 instance ToJSON LedgerPeerSnapshot where
-  toJSON (LedgerPeerSnapshotV1 (slot, pools)) =
-    object [ "version" .= (1 :: Int)
+  toJSON (LedgerPeerSnapshotV2 (slot, pools)) =
+    object [ "version" .= (2 :: Int)
            , "slotNo" .= slot
            , "bigLedgerPools" .= [ object [ "accumulatedStake" .= fromRational @Double accStake
                                           , "relativeStake"  .= fromRational @Double relStake
@@ -121,7 +121,7 @@ instance FromJSON LedgerPeerSnapshot where
     vNum :: Int <- v .: "version"
     parsedSnapshot <-
       case vNum of
-        1 -> do
+        2 -> do
           slot <- v .: "slotNo"
           bigPools <- v .: "bigLedgerPools"
           bigPools' <- forM (zip [0 :: Int ..] bigPools) \(idx, poolO) -> do
@@ -132,7 +132,7 @@ instance FromJSON LedgerPeerSnapshot where
                                  return (accStake, (reStake, relays))
                          withObject ("bigLedgerPools[" <> show idx <> "]") f (Object poolO)
 
-          return $ LedgerPeerSnapshotV1 (slot, bigPools')
+          return $ LedgerPeerSnapshotV2 (slot, bigPools')
         _ -> fail $ "Network.LedgerPeers.Type: parseJSON: failed to parse unsupported version " <> show vNum
     case migrateLedgerPeerSnapshot parsedSnapshot of
       Just payload -> return $ LedgerPeerSnapshot payload
@@ -162,9 +162,9 @@ instance FromCBOR WithOriginCoded where
       _      -> fail "LedgerPeers.Type: Unrecognized list length while decoding WithOrigin SlotNo"
 
 instance ToCBOR LedgerPeerSnapshot where
-  toCBOR (LedgerPeerSnapshotV1 (wOrigin, pools)) =
+  toCBOR (LedgerPeerSnapshotV2 (wOrigin, pools)) =
        Codec.encodeListLen 2
-    <> Codec.encodeWord8 1
+    <> Codec.encodeWord8 2
     <> toCBOR (WithOriginCoded wOrigin, pools')
     where
       pools' =
@@ -177,7 +177,7 @@ instance FromCBOR LedgerPeerSnapshot where
     Codec.decodeListLenOf 2
     version <- Codec.decodeWord8
     case version of
-      1 -> LedgerPeerSnapshotV1 <$> do
+      2 -> LedgerPeerSnapshotV2 <$> do
              (WithOriginCoded wOrigin, pools) <- fromCBOR
              let pools' = [(accStake, (relStake, relays'))
                           | (AccPoolStakeCoded accStake, (PoolStakeCoded relStake, relays)) <- pools

diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/LedgerPeers.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/LedgerPeers.hs
@@ -188,7 +188,7 @@ instance Arbitrary ArbStakeMapOverSource where
     (peerMap, bigPeerMap, cachedSlot) <-
       return $ case peerSnapshot of
                  Nothing -> (Map.empty, Map.empty, Nothing)
-                 Just (LedgerPeerSnapshotV1 (At slot, accPools))
+                 Just (LedgerPeerSnapshotV2 (At slot, accPools))
                    -> (Map.fromList accPools, Map.fromList accPools, Just slot)
                  _otherwise -> error "impossible!"
     return $ ArbStakeMapOverSource StakeMapOverSource {
@@ -206,7 +206,7 @@ instance Arbitrary ArbStakeMapOverSource where
       genPeerSnapshot = do
         slotNo <- At . getPositive <$> arbitrary
         pools <- accumulateBigLedgerStake . getLedgerPools <$> arbitrary
-        return $ LedgerPeerSnapshotV1 (slotNo, pools)
+        return $ LedgerPeerSnapshotV2 (slotNo, pools)
 
 -- | This test checks whether requesting ledger peers works as intended
 -- when snapshot data is available. For each request, peers must be returned from the right
@@ -529,7 +529,7 @@ prop_ledgerPeerSnapshotCBORV1 slotNo
                 (counterexample . ("CBOR round trip failed: " <>) . show <*> (snapshot ==))
                 decoded
   where
-    snapshot = snapshotV1 slotNo ledgerPools
+    snapshot = snapshotV2 slotNo ledgerPools
     encoded = toFlatTerm . toCBOR $ snapshot
     decoded = fromFlatTerm fromCBOR encoded
 
@@ -545,15 +545,15 @@ prop_ledgerPeerSnapshotJSONV1 slotNo
             (counterexample . ("JSON round trip failed: " <>) . show <*> nearlyEqualModuloFullyQualified snapshot)
             roundTrip
   where
-    snapshot = snapshotV1 slotNo ledgerPools
+    snapshot = snapshotV2 slotNo ledgerPools
     roundTrip = case fromJSON . toJSON $ snapshot of
                   Aeson.Success s -> Right s
                   Error str       -> Left str
 
     nearlyEqualModuloFullyQualified snapshotOriginal snapshotRoundTripped =
-      let LedgerPeerSnapshotV1 (wOrigin, relaysWithAccStake) = snapshotOriginal
+      let LedgerPeerSnapshotV2 (wOrigin, relaysWithAccStake) = snapshotOriginal
           strippedRelaysWithAccStake = stripFQN <$> relaysWithAccStake
-          LedgerPeerSnapshotV1 (wOrigin', relaysWithAccStake') = snapshotRoundTripped
+          LedgerPeerSnapshotV2 (wOrigin', relaysWithAccStake') = snapshotRoundTripped
           strippedRelaysWithAccStake' = stripFQN <$> relaysWithAccStake'
       in
              wOrigin === wOrigin'
@@ -589,11 +589,11 @@ prop_ledgerPeerSnapshotJSONV1 slotNo
 
 -- | helper functions for ledgerpeersnapshot encoding tests
 --
-snapshotV1 :: ArbitrarySlotNo
+snapshotV2 :: ArbitrarySlotNo
            -> LedgerPools
            -> LedgerPeerSnapshot
-snapshotV1 (ArbitrarySlotNo slot)
-           (LedgerPools pools) = LedgerPeerSnapshotV1 (originOrSlot, poolStakeWithAccumulation)
+snapshotV2 (ArbitrarySlotNo slot)
+           (LedgerPools pools) = LedgerPeerSnapshotV2 (originOrSlot, poolStakeWithAccumulation)
   where
     poolStakeWithAccumulation = Map.assocs . accPoolStake $ pools
     originOrSlot = if slot == 0