Tweak and extend Peras cert field projection typeclasses

Author: agustinmista

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

@@ -3,8 +3,8 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -20,10 +20,9 @@ module Ouroboros.Consensus.Block.SupportsPeras
   , PerasCfg (..)
   , ValidatedPerasCert (..)
   , makePerasCfg
-  , HasPerasCert (..)
-  , getPerasCertRound
-  , getPerasCertBoostedBlock
-  , getPerasCertBoost
+  , HasPerasCertRound (..)
+  , HasPerasCertBoostedBlock (..)
+  , HasPerasCertBoost (..)
 
     -- * Ouroboros Peras round length
   , PerasRoundLength (..)
@@ -174,20 +173,29 @@ makePerasCfg _ =
     { perasCfgWeightBoost = boostPerCert
     }
 
-class StandardHash blk => HasPerasCert cert blk where
-  getPerasCert :: cert blk -> PerasCert blk
+-- | Extract the certificate round from a Peras certificate container
+class HasPerasCertRound cert where
+  getPerasCertRound :: cert -> PerasRoundNo
 
-instance StandardHash blk => HasPerasCert PerasCert blk where
-  getPerasCert = id
+instance HasPerasCertRound (PerasCert blk) where
+  getPerasCertRound = pcCertRound
 
-instance StandardHash blk => HasPerasCert ValidatedPerasCert blk where
-  getPerasCert = vpcCert
+instance HasPerasCertRound (ValidatedPerasCert blk) where
+  getPerasCertRound = getPerasCertRound . vpcCert
 
-getPerasCertRound :: HasPerasCert cert blk => cert blk -> PerasRoundNo
-getPerasCertRound = pcCertRound . getPerasCert
+-- | Extract the boosted block point from a Peras certificate container
+class HasPerasCertBoostedBlock cert blk | cert -> blk where
+  getPerasCertBoostedBlock :: cert -> Point blk
 
-getPerasCertBoostedBlock :: HasPerasCert cert blk => cert blk -> Point blk
-getPerasCertBoostedBlock = pcCertBoostedBlock . getPerasCert
+instance HasPerasCertBoostedBlock (PerasCert blk) blk where
+  getPerasCertBoostedBlock = pcCertBoostedBlock
 
-getPerasCertBoost :: ValidatedPerasCert blk -> PerasWeight
-getPerasCertBoost = vpcCertBoost
+instance HasPerasCertBoostedBlock (ValidatedPerasCert blk) blk where
+  getPerasCertBoostedBlock = getPerasCertBoostedBlock . vpcCert
+
+-- | Extract the certificate boost from a Peras certificate container
+class HasPerasCertBoost cert where
+  getPerasCertBoost :: cert -> PerasWeight
+
+instance HasPerasCertBoost (ValidatedPerasCert blk) where
+  getPerasCertBoost = vpcCertBoost

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

@@ -31,7 +31,7 @@ takeAscMap :: Int -> Map k v -> Map k v
 takeAscMap n = Map.fromDistinctAscList . take n . Map.toAscList
 
 makePerasCertPoolReaderFromSnapshot ::
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   STM m (PerasCertSnapshot blk) ->
   ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
 makePerasCertPoolReaderFromSnapshot getCertSnapshot =
@@ -43,15 +43,15 @@ makePerasCertPoolReaderFromSnapshot getCertSnapshot =
         let certsAfterLastKnown =
               PerasCertDB.getCertsAfter certSnapshot lastKnown
         let loadCertsAfterLastKnown =
-              pure (getPerasCert <$> takeAscMap (fromIntegral limit) certsAfterLastKnown)
+              pure (vpcCert <$> takeAscMap (fromIntegral limit) certsAfterLastKnown)
         pure $
           if Map.null certsAfterLastKnown
             then Nothing
             else Just loadCertsAfterLastKnown
     }
 
 makePerasCertPoolReaderFromCertDB ::
-  (IOLike m, StandardHash blk) =>
+  IOLike m =>
   PerasCertDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
 makePerasCertPoolReaderFromCertDB perasCertDB =
   makePerasCertPoolReaderFromSnapshot (PerasCertDB.getCertSnapshot perasCertDB)
@@ -71,7 +71,7 @@ makePerasCertPoolWriterFromCertDB 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

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

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

@@ -606,7 +606,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 ->
   ValidatedPerasCert blk ->

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

@@ -221,7 +221,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

@@ -140,7 +140,7 @@ prop_smoke =
                 let rawContent =
                       Map.toAscList $
                         PerasCertDB.getCertsAfter snap (PerasCertDB.zeroPerasCertTicketNo)
-                pure $ getPerasCert . snd <$> rawContent
+                pure $ vpcCert . snd <$> rawContent
 
           return (outboundPoolReader, inboundPoolWriter, getAllInboundPoolContent)
        in

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

@@ -49,7 +49,6 @@ addCert model@Model{certs} cert
   | otherwise = model{certs = Set.insert cert certs}
 
 hasRoundNo ::
-  StandardHash blk =>
   Set (ValidatedPerasCert blk) ->
   ValidatedPerasCert blk ->
   Bool
@@ -65,7 +64,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