Simplify HasPerasCertX field accessors

Conflicts:
  ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/ObjectPool/PerasCert.hs
  ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ObjectDiffusion/PerasCert/Smoke.hs

Author: agustinmista

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs

@@ -19,10 +19,9 @@ module Ouroboros.Consensus.Block.SupportsPeras
   , PerasCfg (..)
   , ValidatedPerasCert (..)
   , makePerasCfg
-  , HasPerasCert (..)
-  , getPerasCertRound
-  , getPerasCertBoostedBlock
-  , getPerasCertBoost
+  , HasPerasCertRound (..)
+  , HasPerasCertBoostedBlock (..)
+  , HasPerasCertBoost (..)
 
     -- * Ouroboros Peras round length
   , PerasRoundLength (..)
@@ -167,29 +166,47 @@ makePerasCfg _ =
     { perasCfgWeightBoost = boostPerCert
     }
 
-class StandardHash blk => HasPerasCert cert blk | cert -> blk where
-  getPerasCert :: cert -> PerasCert blk
+-- | Extract the certificate round from a Peras certificate container
+class HasPerasCertRound cert where
+  getPerasCertRound :: cert -> PerasRoundNo
 
-getPerasCertRound :: HasPerasCert cert blk => cert -> PerasRoundNo
-getPerasCertRound = pcCertRound . getPerasCert
+instance HasPerasCertRound (PerasCert blk) where
+  getPerasCertRound = pcCertRound
 
-getPerasCertBoostedBlock :: HasPerasCert cert blk => cert -> Point blk
-getPerasCertBoostedBlock = pcCertBoostedBlock . getPerasCert
+instance HasPerasCertRound (ValidatedPerasCert blk) where
+  getPerasCertRound = getPerasCertRound . vpcCert
 
-instance StandardHash blk => HasPerasCert (PerasCert blk) blk where
-  getPerasCert = id
+instance
+  HasPerasCertRound cert =>
+  HasPerasCertRound (WithArrivalTime cert)
+  where
+  getPerasCertRound = getPerasCertRound . forgetArrivalTime
+
+-- | Extract the boosted block point from a Peras certificate container
+class HasPerasCertBoostedBlock cert blk | cert -> blk where
+  getPerasCertBoostedBlock :: cert -> Point blk
 
-instance StandardHash blk => HasPerasCert (ValidatedPerasCert blk) blk where
-  getPerasCert = vpcCert
+instance HasPerasCertBoostedBlock (PerasCert blk) blk where
+  getPerasCertBoostedBlock = pcCertBoostedBlock
 
-instance HasPerasCert cert blk => HasPerasCert (WithArrivalTime cert) blk where
-  getPerasCert = getPerasCert . forgetArrivalTime
+instance HasPerasCertBoostedBlock (ValidatedPerasCert blk) blk where
+  getPerasCertBoostedBlock = getPerasCertBoostedBlock . vpcCert
 
-class HasPerasCertBoost cert blk | cert -> blk where
+instance
+  HasPerasCertBoostedBlock cert blk =>
+  HasPerasCertBoostedBlock (WithArrivalTime cert) blk
+  where
+  getPerasCertBoostedBlock = getPerasCertBoostedBlock . forgetArrivalTime
+
+-- | Extract the certificate boost from a Peras certificate container
+class HasPerasCertBoost cert where
   getPerasCertBoost :: cert -> PerasWeight
 
-instance HasPerasCertBoost (ValidatedPerasCert blk) blk where
+instance HasPerasCertBoost (ValidatedPerasCert blk) where
   getPerasCertBoost = vpcCertBoost
 
-instance HasPerasCertBoost cert blk => HasPerasCertBoost (WithArrivalTime cert) blk where
+instance
+  HasPerasCertBoost cert =>
+  HasPerasCertBoost (WithArrivalTime cert)
+  where
   getPerasCertBoost = getPerasCertBoost . forgetArrivalTime

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/ObjectPool/PerasCert.hs

@@ -16,7 +16,11 @@ import qualified Data.Map as Map
 import GHC.Exception (throw)
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.BlockchainTime (WithArrivalTime)
-import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemTime (..), addArrivalTime)
+import Ouroboros.Consensus.BlockchainTime.WallClock.Types
+  ( SystemTime (..)
+  , WithArrivalTime (..)
+  , addArrivalTime
+  )
 import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
 import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
@@ -29,7 +33,7 @@ import qualified Ouroboros.Consensus.Storage.PerasCertDB.API as PerasCertDB
 import Ouroboros.Consensus.Util.IOLike
 
 makePerasCertPoolReaderFromSnapshot ::
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   STM m (PerasCertSnapshot blk) ->
   ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
 makePerasCertPoolReaderFromSnapshot getCertSnapshot =
@@ -40,15 +44,15 @@ makePerasCertPoolReaderFromSnapshot getCertSnapshot =
         certSnapshot <- getCertSnapshot
         pure $
           take (fromIntegral limit) $
-            [ (ticketNo, getPerasCertRound cert, pure (getPerasCert cert))
+            [ (ticketNo, getPerasCertRound cert, pure (vpcCert (forgetArrivalTime cert)))
             | (ticketNo, cert) <-
                 Map.toAscList $
                   PerasCertDB.getCertsAfter certSnapshot lastKnown
             ]
     }
 
 makePerasCertPoolReaderFromCertDB ::
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   PerasCertDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
 makePerasCertPoolReaderFromCertDB perasCertDB =
   makePerasCertPoolReaderFromSnapshot (PerasCertDB.getCertSnapshot perasCertDB)
@@ -68,7 +72,7 @@ makePerasCertPoolWriterFromCertDB systemTime perasCertDB =
     }
 
 makePerasCertPoolReaderFromChainDB ::
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   ChainDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
 makePerasCertPoolReaderFromChainDB chainDB =
   makePerasCertPoolReaderFromSnapshot (ChainDB.getPerasCertSnapshot chainDB)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs

@@ -327,7 +327,7 @@ addBlockAsync CDB{cdbTracer, cdbChainSelQueue} =
 
 addPerasCertAsync ::
   forall m blk.
-  (IOLike m, HasHeader blk) =>
+  IOLike m =>
   ChainDbEnv m blk ->
   WithArrivalTime (ValidatedPerasCert blk) ->
   m (AddPerasCertPromise m)

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs

@@ -607,7 +607,7 @@ addBlockToAdd tracer (ChainSelQueue{varChainSelQueue, varChainSelPoints}) punish
 
 -- | Add a Peras certificate to the background queue.
 addPerasCertToQueue ::
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   Tracer m (TraceAddPerasCertEvent blk) ->
   ChainSelQueue m blk ->
   WithArrivalTime (ValidatedPerasCert blk) ->

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasCertDB/Impl.hs

@@ -222,7 +222,7 @@ implGetCertSnapshot PerasCertDbEnv{pcdbVolatileState} =
 
 implGarbageCollect ::
   forall m blk.
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   PerasCertDbEnv m blk -> SlotNo -> m ()
 implGarbageCollect PerasCertDbEnv{pcdbVolatileState} slot =
   -- No need to update the 'Fingerprint' as we only remove certificates that do

ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/ObjectDiffusion/PerasCert/Smoke.hs

@@ -18,6 +18,7 @@ import Ouroboros.Consensus.Block.SupportsPeras
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
   ( RelativeTime (..)
   , SystemTime (..)
+  , WithArrivalTime (..)
   , addArrivalTime
   , systemTimeCurrent
   )
@@ -155,6 +156,6 @@ prop_smoke protocolConstants (ListWithUniqueIds certs) =
           let rawContent =
                 Map.toAscList $
                   PerasCertDB.getCertsAfter snap (PerasCertDB.zeroPerasCertTicketNo)
-          pure $ getPerasCert . snd <$> rawContent
+          pure $ vpcCert . forgetArrivalTime . snd <$> rawContent
 
     return (outboundPoolReader, inboundPoolWriter, getAllInboundPoolContent)

ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasCertDB/Model.hs

@@ -50,7 +50,6 @@ addCert model@Model{certs} cert
   | otherwise = model{certs = Set.insert cert certs}
 
 hasRoundNo ::
-  StandardHash blk =>
   Set (WithArrivalTime (ValidatedPerasCert blk)) ->
   WithArrivalTime (ValidatedPerasCert blk) ->
   Bool
@@ -66,7 +65,7 @@ getWeightSnapshot Model{certs} =
     | cert <- Set.toList certs
     ]
 
-garbageCollect :: StandardHash blk => SlotNo -> Model blk -> Model blk
+garbageCollect :: SlotNo -> Model blk -> Model blk
 garbageCollect slot model@Model{certs} =
   model{certs = Set.filter keepCert certs}
  where