Added a property test that verifies validity of peer snapshot CBOR

encoding, as well as checking that ToCBOR and FromCBOR are working
together correctly.

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs

@@ -35,7 +35,8 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint)
 -- from the current ledger. Consensus uses CBOR.
 newtype LedgerPeerSnapshot = LedgerPeerSnapshot
   { unLedgerPeerSnapshot :: (WithOrigin SlotNo, [(AccPoolStake, (PoolStake, NonEmpty RelayAccessPoint))]) }
-  deriving newtype (Show, ToCBOR, FromCBOR)
+  deriving (Eq)
+  deriving newtype (Show, NFData, ToCBOR, FromCBOR)
 
 -- | Which ledger peers to pick.
 --
@@ -69,7 +70,7 @@ newtype PoolStake = PoolStake { unPoolStake :: Rational }
 --
 newtype AccPoolStake = AccPoolStake { unAccPoolStake :: Rational }
     deriving (Eq, Ord, Show)
-    deriving newtype (Fractional, Num, FromCBOR, ToCBOR) -- CBOR to support LedgerPeerSnapshot
+    deriving newtype (Fractional, Num, NFData, FromCBOR, ToCBOR) -- CBOR to support LedgerPeerSnapshot
 
 -- | A boolean like type.  Big ledger peers are the largest SPOs which control
 -- 90% of staked stake.

ouroboros-network/ouroboros-network.cabal

@@ -166,6 +166,7 @@ library sim-tests-lib
                        QuickCheck,
                        aeson,
                        array,
+                       cardano-binary,
                        cborg,
                        containers,
                        deepseq,

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/LedgerPeers.hs

@@ -8,6 +8,8 @@
 
 module Test.Ouroboros.Network.LedgerPeers where
 
+import Codec.CBOR.FlatTerm
+import Control.Concurrent.Class.MonadSTM.Strict
 import Control.Exception (SomeException (..))
 import Control.Monad.Class.MonadAsync
 import Control.Monad.Class.MonadFork
@@ -32,8 +34,8 @@ import System.Random
 
 import Network.DNS (Domain)
 
-import Cardano.Slotting.Slot (SlotNo, WithOrigin (..))
-import Control.Concurrent.Class.MonadSTM.Strict
+import Cardano.Binary
+import Cardano.Slotting.Slot (SlotNo (..), WithOrigin (..))
 import Ouroboros.Network.PeerSelection.LedgerPeers
 import Ouroboros.Network.PeerSelection.RelayAccessPoint
 import Ouroboros.Network.PeerSelection.RootPeersDNS
@@ -50,6 +52,7 @@ tests = testGroup "Ouroboros.Network.LedgerPeers"
   , testProperty "Pick" prop_pick
   , testProperty "accBigPoolStake" prop_accBigPoolStake
   , testProperty "getLedgerPeers invariants" prop_getLedgerPeers
+  , testProperty "LedgerPeerSnapshot encode/decode" prop_ledgerPeerSnapshot
   ]
 
 newtype ArbitraryPortNumber = ArbitraryPortNumber { getArbitraryPortNumber :: PortNumber }
@@ -95,7 +98,7 @@ newtype ArbitrarySlotNo =
 -- of the tests we run.
 instance Arbitrary ArbitrarySlotNo where
     arbitrary =
-      ArbitrarySlotNo . fromInteger <$> arbitrary
+      ArbitrarySlotNo . SlotNo <$> arbitrarySizedBoundedIntegral
 
 data StakePool = StakePool {
       spStake :: !Word64
@@ -367,6 +370,24 @@ prop_getLedgerPeers (ArbitrarySlotNo curSlot)
                   (pure lsj)
                   (pure (Map.elems (accPoolStake lps)))
 
+-- | Tests if the CBOR encoding is valid, and whether a round
+-- trip results in the original peer snapshot value.
+--
+prop_ledgerPeerSnapshot :: ArbitrarySlotNo
+                        -> LedgerPools
+                        -> Property
+prop_ledgerPeerSnapshot (ArbitrarySlotNo slot)
+                        (LedgerPools pools) =
+  validFlatTerm encoded .&&. either (const False) (snapshot ==) decoded
+  where
+    poolStakeWithAccumulation = Map.assocs . accPoolStake $ pools
+    originOrSlot = if slot == 0
+                   then Origin
+                   else At slot
+    snapshot = LedgerPeerSnapshot (originOrSlot, poolStakeWithAccumulation)
+    encoded = toFlatTerm . toCBOR $ snapshot
+    decoded = fromFlatTerm fromCBOR encoded
+
 -- TODO: Belongs in iosim.
 data SimResult a = SimReturn a [String]
                  | SimException SomeException [String]