diff --git a/ouroboros-consensus-diffusion/changelog.d/20240425_110304_alexander.esgen_customize_prefer_candidate.md b/ouroboros-consensus-diffusion/changelog.d/20240425_110304_alexander.esgen_customize_prefer_candidate.md
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/General.hs b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/General.hs
index 70d454f63c..dd3d43e07b 100644
--- a/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/General.hs
+++ b/ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/General.hs
@@ -74,6 +74,7 @@ import           Test.Util.HardFork.Future (Future)
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Orphans.IOLike ()
 import           Test.Util.Orphans.NoThunks ()
+import           Test.Util.QuickCheck
 import           Test.Util.Range
 import           Test.Util.Shrink (andId, dropId)
 import           Test.Util.Slots (NumSlots (..))
@@ -674,10 +675,6 @@ prop_general_internal syncity pga testOutput =
                 | ((s1, _, max1), (s2, min2, _)) <- orderedPairs extrema
                 ]
       where
-        -- QuickCheck's @==>@ 'discard's the test if @p1@ fails; that's not
-        -- what we want
-        implies p1 p2 = not p1 .||. p2
-
         -- all pairs @(x, y)@ where @x@ precedes @y@ in the given list
         orderedPairs :: [a] -> [(a, a)]
         orderedPairs = \case
diff --git a/ouroboros-consensus-protocol/changelog.d/20240417_122550_alexander.esgen_customize_prefer_candidate.md b/ouroboros-consensus-protocol/changelog.d/20240417_122550_alexander.esgen_customize_prefer_candidate.md
new file mode 100644
index 0000000000..46d7142c99
--- /dev/null
+++ b/ouroboros-consensus-protocol/changelog.d/20240417_122550_alexander.esgen_customize_prefer_candidate.md
@@ -0,0 +1,3 @@
+### Non-Breaking
+
+- Adapted to introduction of new `ChainOrder` type class.
diff --git a/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal b/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal
index 6ffa98f521..157bf870e1 100644
--- a/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal
+++ b/ouroboros-consensus-protocol/ouroboros-consensus-protocol.cabal
@@ -43,6 +43,12 @@ common common-lib
   if flag(asserts)
     ghc-options: -fno-ignore-asserts
 
+common common-test
+  import: common-lib
+  ghc-options:
+    -threaded
+    -rtsopts
+
 library
   import: common-lib
   hs-source-dirs: src/ouroboros-consensus-protocol
@@ -90,3 +96,24 @@ library unstable-protocol-testlib
     cardano-protocol-tpraos,
     cardano-slotting,
     ouroboros-consensus-protocol,
+
+test-suite protocol-test
+  import: common-test
+  type: exitcode-stdio-1.0
+  hs-source-dirs: test/protocol-test
+  main-is: Main.hs
+  other-modules:
+    Test.Consensus.Protocol.Praos.SelectView
+
+  build-depends:
+    QuickCheck,
+    base,
+    cardano-crypto-class,
+    cardano-ledger-binary:testlib,
+    cardano-ledger-core,
+    containers,
+    ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib},
+    ouroboros-consensus-protocol,
+    serialise,
+    tasty,
+    tasty-quickcheck,
diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs
index 99d6914c1d..c8cfba1f69 100644
--- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs
+++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs
@@ -2,8 +2,11 @@
 {-# LANGUAGE DeriveAnyClass             #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DerivingVia                #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 -- | Various things common to iterations of the Praos protocol.
 module Ouroboros.Consensus.Protocol.Praos.Common (
@@ -41,15 +44,7 @@ newtype MaxMajorProtVer = MaxMajorProtVer
   deriving (Eq, Show, Generic)
   deriving newtype NoThunks
 
--- | View of the ledger tip for chain selection.
---
--- We order between chains as follows:
---
--- 1. By chain length, with longer chains always preferred.
--- 2. If the tip of each chain was issued by the same agent, then we prefer
---    the chain whose tip has the highest ocert issue number.
--- 3. By a VRF value from the chain tip, with lower values preferred. See
---    @pTieBreakVRFValue@ for which one is used.
+-- | View of the tip of a header fragment for chain selection.
 data PraosChainSelectView c = PraosChainSelectView
   { csvChainLength :: BlockNo,
     csvSlotNo      :: SlotNo,
@@ -59,6 +54,13 @@ data PraosChainSelectView c = PraosChainSelectView
   }
   deriving (Show, Eq, Generic, NoThunks)
 
+-- | We order between chains as follows:
+--
+-- 1. By chain length, with longer chains always preferred.
+-- 2. If the tip of each chain was issued by the same agent, then we prefer
+--    the chain whose tip has the highest ocert issue number.
+-- 3. By a VRF value from the chain tip, with lower values preferred. See
+--    @pTieBreakVRFValue@ for which one is used.
 instance Crypto c => Ord (PraosChainSelectView c) where
   compare =
     mconcat
@@ -80,6 +82,9 @@ instance Crypto c => Ord (PraosChainSelectView c) where
         | otherwise =
             EQ
 
+deriving via SimpleChainOrder (PraosChainSelectView c)
+  instance Crypto c => ChainOrder (PraosChainSelectView c)
+
 data PraosCanBeLeader c = PraosCanBeLeader
   { -- | Certificate delegating rights from the stake pool cold key (or
     -- genesis stakeholder delegate cold key) to the online KES key.
diff --git a/ouroboros-consensus-protocol/test/protocol-test/Main.hs b/ouroboros-consensus-protocol/test/protocol-test/Main.hs
new file mode 100644
index 0000000000..be4b967fea
--- /dev/null
+++ b/ouroboros-consensus-protocol/test/protocol-test/Main.hs
@@ -0,0 +1,14 @@
+module Main (main) where
+
+import qualified Test.Consensus.Protocol.Praos.SelectView
+import           Test.Tasty
+import           Test.Util.TestEnv
+
+main :: IO ()
+main = defaultMainWithTestEnv defaultTestEnvConfig tests
+
+tests :: TestTree
+tests =
+    testGroup "protocol"
+      [ Test.Consensus.Protocol.Praos.SelectView.tests
+      ]
diff --git a/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs b/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs
new file mode 100644
index 0000000000..828b11ee0e
--- /dev/null
+++ b/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.Consensus.Protocol.Praos.SelectView (tests) where
+
+import qualified Cardano.Crypto.Hash as Crypto
+import qualified Cardano.Crypto.Util as Crypto
+import           Cardano.Crypto.VRF (OutputVRF, mkTestOutputVRF)
+import           Cardano.Ledger.Crypto (Crypto (..), StandardCrypto)
+import qualified Cardano.Ledger.Keys as SL
+import           Codec.Serialise (encode)
+import           Control.Monad
+import           Data.Containers.ListUtils (nubOrdOn)
+import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Protocol.Praos.Common
+import           Test.Cardano.Ledger.Binary.Arbitrary ()
+import           Test.Ouroboros.Consensus.Protocol
+import           Test.QuickCheck.Gen (Gen (..))
+import           Test.QuickCheck.Random (mkQCGen)
+import           Test.Tasty
+import           Test.Tasty.QuickCheck hiding (elements)
+import           Test.Util.QuickCheck
+import           Test.Util.TestEnv
+
+tests :: TestTree
+tests = testGroup "PraosChainSelectView"
+    [   adjustQuickCheckTests (* 50)
+      -- Use a small max size by default in order to have a decent chance to
+      -- trigger the actual tiebreaker cases.
+      $ adjustQuickCheckMaxSize (`div` 10)
+      $ tests_chainOrder (Proxy @(PraosChainSelectView StandardCrypto))
+    ]
+
+instance Crypto c => Arbitrary (PraosChainSelectView c) where
+  arbitrary = do
+      size           <- fromIntegral <$> getSize
+      csvChainLength <- BlockNo <$> choose (1, size)
+      csvSlotNo      <- SlotNo  <$> choose (1, size)
+      csvIssuer      <- elements knownIssuers
+      csvIssueNo     <- genIssueNo
+      pure PraosChainSelectView {
+          csvChainLength
+        , csvSlotNo
+        , csvIssuer
+        , csvIssueNo
+        , csvTieBreakVRF = mkVRFFor csvIssuer csvSlotNo
+        }
+   where
+     -- We want to draw from the same small set of issuer identities in order to
+     -- have a chance to explore cases where the issuers of two 'SelectView's
+     -- are identical.
+     knownIssuers :: [SL.VKey SL.BlockIssuer c]
+     knownIssuers =
+           nubOrdOn SL.hashKey
+         $ unGen (replicateM numIssuers (SL.VKey <$> arbitrary)) randomSeed 100
+       where
+         randomSeed = mkQCGen 4 -- chosen by fair dice roll
+         numIssuers = 10
+
+     -- TODO Actually randomize this once the issue number tiebreaker has been
+     -- fixed to be transitive. See the document in
+     -- https://github.com/IntersectMBO/ouroboros-consensus/pull/891 for
+     -- details.
+     --
+     -- TL;DR: In an edge case, the issue number tiebreaker prevents the
+     -- chain order from being transitive. This could be fixed relatively
+     -- easily, namely by swapping the issue number tiebreaker and the VRF
+     -- tiebreaker. However, this is technically not backwards-compatible,
+     -- impacting the current pre-Conway diffusion pipelining scheme.
+     --
+     -- See https://github.com/IntersectMBO/ouroboros-consensus/issues/1075.
+     genIssueNo = pure 1
+
+     -- The header VRF is a deterministic function of the issuer VRF key, the
+     -- slot and the epoch nonce. Additionally, for any particular chain, the
+     -- slot determines the epoch nonce.
+     mkVRFFor :: SL.VKey SL.BlockIssuer c -> SlotNo -> OutputVRF (VRF c)
+     mkVRFFor issuer slot =
+           mkTestOutputVRF
+         $ Crypto.bytesToNatural
+         $ Crypto.hashToBytes
+         $ Crypto.xor (Crypto.castHash issuerHash)
+         $ Crypto.hashWithSerialiser encode slot
+       where
+         SL.KeyHash issuerHash = SL.hashKey issuer
diff --git a/ouroboros-consensus/changelog.d/20240417_122327_alexander.esgen_customize_prefer_candidate.md b/ouroboros-consensus/changelog.d/20240417_122327_alexander.esgen_customize_prefer_candidate.md
new file mode 100644
index 0000000000..a7326aebb5
--- /dev/null
+++ b/ouroboros-consensus/changelog.d/20240417_122327_alexander.esgen_customize_prefer_candidate.md
@@ -0,0 +1,5 @@
+### Breaking
+
+- Introduced new `ChainOrder` (with `preferCandidate`) class for `SelectView`s,
+  and add necessary instances. Adapted `preferAnchoredCandidate` to use
+  `preferCandidate` instead of relying on `preferAnchoredFragment`.
diff --git a/ouroboros-consensus/ouroboros-consensus.cabal b/ouroboros-consensus/ouroboros-consensus.cabal
index a4596fbf15..7253ed09cf 100644
--- a/ouroboros-consensus/ouroboros-consensus.cabal
+++ b/ouroboros-consensus/ouroboros-consensus.cabal
@@ -331,6 +331,7 @@ library unstable-consensus-testlib
     Test.Ouroboros.Consensus.ChainGenerator.Slot
     Test.Ouroboros.Consensus.ChainGenerator.Some
     Test.Ouroboros.Consensus.DiffusionPipelining
+    Test.Ouroboros.Consensus.Protocol
     Test.QuickCheck.Extras
     Test.Util.BoolProps
     Test.Util.ChainDB
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs
index 1efbb532c7..08af1c63fc 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs
@@ -34,3 +34,13 @@ class ( GetHeader blk
                      => BlockConfig blk
                      -> Header blk -> SelectView (BlockProtocol blk)
   selectView _ = blockNo
+
+  projectChainOrderConfig ::
+       BlockConfig blk
+    -> ChainOrderConfig (SelectView (BlockProtocol blk))
+
+  default projectChainOrderConfig ::
+       ChainOrderConfig (SelectView (BlockProtocol blk)) ~ ()
+    => BlockConfig blk
+    -> ChainOrderConfig (SelectView (BlockProtocol blk))
+  projectChainOrderConfig _ = ()
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
index e6c3a13b03..0fa2e469a6 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs
@@ -21,6 +21,7 @@
 module Ouroboros.Consensus.HardFork.Combinator.AcrossEras (
     -- * Value for /each/ era
     PerEraBlockConfig (..)
+  , PerEraChainOrderConfig (..)
   , PerEraCodecConfig (..)
   , PerEraConsensusConfig (..)
   , PerEraLedgerConfig (..)
@@ -97,13 +98,14 @@ import           Ouroboros.Consensus.Util.Condense (Condense (..))
   Value for /each/ era
 -------------------------------------------------------------------------------}
 
-newtype PerEraBlockConfig     xs = PerEraBlockConfig     { getPerEraBlockConfig     :: NP BlockConfig                xs }
-newtype PerEraCodecConfig     xs = PerEraCodecConfig     { getPerEraCodecConfig     :: NP CodecConfig                xs }
-newtype PerEraConsensusConfig xs = PerEraConsensusConfig { getPerEraConsensusConfig :: NP WrapPartialConsensusConfig xs }
-newtype PerEraLedgerConfig    xs = PerEraLedgerConfig    { getPerEraLedgerConfig    :: NP WrapPartialLedgerConfig    xs }
-newtype PerEraStorageConfig   xs = PerEraStorageConfig   { getPerEraStorageConfig   :: NP StorageConfig              xs }
+newtype PerEraBlockConfig      xs = PerEraBlockConfig      { getPerEraBlockConfig      :: NP BlockConfig                xs }
+newtype PerEraChainOrderConfig xs = PerEraChainOrderConfig { getPerEraChainOrderConfig :: NP WrapChainOrderConfig       xs }
+newtype PerEraCodecConfig      xs = PerEraCodecConfig      { getPerEraCodecConfig      :: NP CodecConfig                xs }
+newtype PerEraConsensusConfig  xs = PerEraConsensusConfig  { getPerEraConsensusConfig  :: NP WrapPartialConsensusConfig xs }
+newtype PerEraLedgerConfig     xs = PerEraLedgerConfig     { getPerEraLedgerConfig     :: NP WrapPartialLedgerConfig    xs }
+newtype PerEraStorageConfig    xs = PerEraStorageConfig    { getPerEraStorageConfig    :: NP StorageConfig              xs }
 
-newtype PerEraProtocolParams  xs = PerEraProtocolParams  { getPerEraProtocolParams  :: NP ProtocolParams             xs }
+newtype PerEraProtocolParams   xs = PerEraProtocolParams   { getPerEraProtocolParams   :: NP ProtocolParams             xs }
 
 {-------------------------------------------------------------------------------
   Values for /some/ eras
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs
index dd8f93b7bd..aae4e600ee 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs
@@ -71,10 +71,26 @@ newtype HardForkSelectView xs = HardForkSelectView {
 
 instance CanHardFork xs => Ord (HardForkSelectView xs) where
   compare (HardForkSelectView l) (HardForkSelectView r) =
-     acrossEraSelection
-       hardForkChainSel
-       (mapWithBlockNo getOneEraSelectView l)
-       (mapWithBlockNo getOneEraSelectView r)
+      acrossEraSelection
+        AcrossEraCompare
+        (hpure Proxy)
+        hardForkChainSel
+        (mapWithBlockNo getOneEraSelectView l)
+        (mapWithBlockNo getOneEraSelectView r)
+
+instance CanHardFork xs => ChainOrder (HardForkSelectView xs) where
+  type ChainOrderConfig (HardForkSelectView xs) = PerEraChainOrderConfig xs
+
+  preferCandidate
+    (PerEraChainOrderConfig cfg)
+    (HardForkSelectView ours)
+    (HardForkSelectView cand) =
+      acrossEraSelection
+        AcrossEraPreferCandidate
+        cfg
+        hardForkChainSel
+        (mapWithBlockNo getOneEraSelectView ours)
+        (mapWithBlockNo getOneEraSelectView cand)
 
 mkHardForkSelectView ::
      BlockNo
@@ -133,6 +149,12 @@ instance CanHardFork xs => BlockSupportsProtocol (HardForkBlock xs) where
     where
       cfgs = getPerEraBlockConfig hardForkBlockConfigPerEra
 
+  projectChainOrderConfig =
+        PerEraChainOrderConfig
+      . hcmap proxySingle (WrapChainOrderConfig . projectChainOrderConfig)
+      . getPerEraBlockConfig
+      . hardForkBlockConfigPerEra
+
 {-------------------------------------------------------------------------------
   Ticking the chain dependent state
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs
index 4a2ce969f0..24b74e7d2f 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs
@@ -11,7 +11,8 @@
 
 -- | Infrastructure for doing chain selection across eras
 module Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel (
-    AcrossEraSelection (..)
+    AcrossEraMode (..)
+  , AcrossEraSelection (..)
   , WithBlockNo (..)
   , acrossEraSelection
   , mapWithBlockNo
@@ -41,7 +42,12 @@ data AcrossEraSelection :: Type -> Type -> Type where
 
   -- | Two eras using the same 'SelectView'. In this case, we can just compare
   -- chains even across eras, as the chain ordering is fully captured by
-  -- 'SelectView' and its 'Ord' instance.
+  -- 'SelectView' and its 'ChainOrder' instance.
+  --
+  -- We use the 'ChainOrderConfig' of the 'SelectView' in the newer era (with
+  -- the intuition that newer eras are generally "preferred") when invoking
+  -- 'compareChains'. However, this choice is arbitrary; we could also make it
+  -- configurable here.
   CompareSameSelectView ::
        SelectView (BlockProtocol x) ~ SelectView (BlockProtocol y)
     => AcrossEraSelection x y
@@ -50,55 +56,99 @@ data AcrossEraSelection :: Type -> Type -> Type where
   Compare two eras
 -------------------------------------------------------------------------------}
 
+
+-- | GADT indicating whether we are lifting 'compare' or 'preferCandidate' to
+-- the HFC, together with the type of configuration we need for that and the
+-- result type.
+data AcrossEraMode cfg a where
+  AcrossEraCompare         :: AcrossEraMode Proxy                Ordering
+  AcrossEraPreferCandidate :: AcrossEraMode WrapChainOrderConfig Bool
+
+applyAcrossEraMode ::
+     ChainOrder sv
+  => cfg blk
+  -> (WrapChainOrderConfig blk -> ChainOrderConfig sv)
+  -> AcrossEraMode cfg a
+  -> sv -> sv -> a
+applyAcrossEraMode cfg f = \case
+    AcrossEraCompare         -> compare
+    AcrossEraPreferCandidate -> preferCandidate (f cfg)
+
+data FlipArgs = KeepArgs | FlipArgs
+
 acrossEras ::
-     forall blk blk'. SingleEraBlock blk
-  => WithBlockNo WrapSelectView blk
+     forall blk blk' cfg a. SingleEraBlock blk
+  => FlipArgs
+  -> AcrossEraMode cfg a
+  -> cfg                        blk'
+     -- ^ The configuration corresponding to the later block/era, also see
+     -- 'CompareSameSelectView'.
+  -> WithBlockNo WrapSelectView blk
   -> WithBlockNo WrapSelectView blk'
   -> AcrossEraSelection blk blk'
-  -> Ordering
-acrossEras (WithBlockNo bnoL (WrapSelectView l))
-           (WithBlockNo bnoR (WrapSelectView r)) = \case
-    CompareBlockNo        -> compare bnoL bnoR
-    CompareSameSelectView -> compare l r
+  -> a
+acrossEras flipArgs mode cfg
+  (WithBlockNo bnoL (WrapSelectView l))
+  (WithBlockNo bnoR (WrapSelectView r)) = \case
+    CompareBlockNo        -> maybeFlip cmp bnoL bnoR
+      where
+        cmp = applyAcrossEraMode cfg (const ()) mode
+    CompareSameSelectView -> maybeFlip cmp l r
+      where
+        cmp = applyAcrossEraMode cfg (unwrapChainOrderConfig) mode
+  where
+    maybeFlip :: (b -> b -> a) -> b -> b -> a
+    maybeFlip = case flipArgs of
+      KeepArgs -> id
+      FlipArgs -> flip
 
 acrossEraSelection ::
+     forall xs cfg a.
      All SingleEraBlock              xs
-  => Tails AcrossEraSelection        xs
+  => AcrossEraMode cfg a
+  -> NP cfg                          xs
+  -> Tails AcrossEraSelection        xs
   -> WithBlockNo (NS WrapSelectView) xs
   -> WithBlockNo (NS WrapSelectView) xs
-  -> Ordering
-acrossEraSelection = \ffs l r ->
-    goLeft ffs (distribBlockNo l, distribBlockNo r)
+  -> a
+acrossEraSelection mode = \cfg ffs l r ->
+    goBoth cfg ffs (distribBlockNo l, distribBlockNo r)
   where
-    goLeft ::
-         All SingleEraBlock                xs
-      => Tails AcrossEraSelection          xs
-      -> ( NS (WithBlockNo WrapSelectView) xs
-         , NS (WithBlockNo WrapSelectView) xs
+    goBoth ::
+         All SingleEraBlock                xs'
+      => NP cfg                            xs'
+      -> Tails AcrossEraSelection          xs'
+      -> ( NS (WithBlockNo WrapSelectView) xs'
+         , NS (WithBlockNo WrapSelectView) xs'
          )
-      -> Ordering
-    goLeft TNil            = \(a, _) -> case a of {}
-    goLeft (TCons fs ffs') = \case
-        (Z a, Z b) -> compare (dropBlockNo a) (dropBlockNo b)
-        (Z a, S b) ->          goRight a fs b
-        (S a, Z b) -> invert $ goRight b fs a
-        (S a, S b) -> goLeft ffs' (a, b)
-
-    goRight ::
-         forall x xs. (SingleEraBlock x, All SingleEraBlock xs)
-      => WithBlockNo WrapSelectView x
-      -> NP (AcrossEraSelection     x)   xs
-      -> NS (WithBlockNo WrapSelectView) xs
-      -> Ordering
-    goRight a = go
+      -> a
+    goBoth _             TNil            = \(a, _) -> case a of {}
+    goBoth (cfg :* cfgs) (TCons fs ffs') = \case
+        (Z a, Z b) -> cmp (dropBlockNo a) (dropBlockNo b)
+          where
+            cmp = applyAcrossEraMode cfg unwrapChainOrderConfig mode
+        (Z a, S b) -> goOne KeepArgs a cfgs fs b
+        (S a, Z b) -> goOne FlipArgs b cfgs fs a
+        (S a, S b) -> goBoth cfgs ffs' (a, b)
+
+    goOne ::
+         forall x xs'. (SingleEraBlock x, All SingleEraBlock xs')
+      => FlipArgs
+      -> WithBlockNo WrapSelectView x
+      -> NP cfg                          xs'
+      -> NP (AcrossEraSelection     x)   xs'
+      -> NS (WithBlockNo WrapSelectView) xs'
+      -> a
+    goOne flipArgs a = go
       where
-        go :: forall xs'. All SingleEraBlock  xs'
-           => NP (AcrossEraSelection x)       xs'
-           -> NS (WithBlockNo WrapSelectView) xs'
-           -> Ordering
-        go Nil          b  = case b of {}
-        go (f :* _)  (Z b) = acrossEras a b f
-        go (_ :* fs) (S b) = go fs b
+        go :: forall xs''. All SingleEraBlock xs''
+           => NP cfg                          xs''
+           -> NP (AcrossEraSelection x)       xs''
+           -> NS (WithBlockNo WrapSelectView) xs''
+           -> a
+        go _             Nil          b  = case b of {}
+        go (cfg :* _   ) (f :* _)  (Z b) = acrossEras flipArgs mode cfg a b f
+        go (_   :* cfgs) (_ :* fs) (S b) = go cfgs fs b
 
 {-------------------------------------------------------------------------------
   WithBlockNo
@@ -115,12 +165,3 @@ mapWithBlockNo f (WithBlockNo bno fx) = WithBlockNo bno (f fx)
 
 distribBlockNo :: SListI xs => WithBlockNo (NS f) xs -> NS (WithBlockNo f) xs
 distribBlockNo (WithBlockNo b ns) = hmap (WithBlockNo b) ns
-
-{-------------------------------------------------------------------------------
-  Auxiliary
--------------------------------------------------------------------------------}
-
-invert :: Ordering -> Ordering
-invert LT = GT
-invert GT = LT
-invert EQ = EQ
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
index ffd59bbbcd..a3bbacbde1 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
@@ -288,6 +288,8 @@ instance Bridge m a => BlockSupportsProtocol (DualBlock m a) where
   validateView cfg = validateView (dualBlockConfigMain cfg) . dualHeaderMain
   selectView   cfg = selectView   (dualBlockConfigMain cfg) . dualHeaderMain
 
+  projectChainOrderConfig = projectChainOrderConfig . dualBlockConfigMain
+
 {-------------------------------------------------------------------------------
   Ledger errors
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs
index 0663d00e8d..bbe82d62a8 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs
@@ -1,12 +1,20 @@
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE UndecidableInstances       #-}
 
 module Ouroboros.Consensus.Protocol.Abstract (
     -- * Abstract definition of the Ouroboros protocol
     ConsensusConfig
   , ConsensusProtocol (..)
-  , preferCandidate
+    -- * Chain order
+  , ChainOrder (..)
+  , SimpleChainOrder (..)
     -- * Convenience re-exports
   , SecurityParam (..)
   ) where
@@ -41,7 +49,7 @@ class ( Show (ChainDepState   p)
       , Show (LedgerView      p)
       , Eq   (ChainDepState   p)
       , Eq   (ValidationErr   p)
-      , Ord  (SelectView      p)
+      , ChainOrder (SelectView p)
       , NoThunks (ConsensusConfig p)
       , NoThunks (ChainDepState   p)
       , NoThunks (ValidationErr   p)
@@ -66,12 +74,10 @@ class ( Show (ChainDepState   p)
   -- two things independent of a choice of consensus protocol: we never switch
   -- to chains that fork off more than @k@ blocks ago, and we never adopt an
   -- invalid chain. The actual comparison of chains however depends on the chain
-  -- selection protocol. We define chain selection (which is itself a partial
-  -- order) in terms of a totally ordered /select view/ on the headers at the
-  -- tips of those chains: chain A is strictly preferred over chain B whenever
-  -- A's select view is greater than B's select view. When the select view on A
-  -- and B is the same, the chains are considered to be incomparable (neither
-  -- chain is preferred over the other).
+  -- selection protocol. We define chain selection in terms of a /select view/
+  -- on the headers at the tips of those chains: chain A is strictly preferred
+  -- over chain B whenever A's select view is preferred over B's select view
+  -- according to the 'ChainOrder' instance.
   type family SelectView p :: Type
   type SelectView p = BlockNo
 
@@ -170,13 +176,68 @@ class ( Show (ChainDepState   p)
   -- | We require that protocols support a @k@ security parameter
   protocolSecurityParam :: ConsensusConfig p -> SecurityParam
 
--- | Compare a candidate chain to our own
+-- | The chain order of some type; in the Consensus layer, this will always be
+-- the 'SelectView' of some 'ConsensusProtocol'.
 --
--- If both chains are equally preferable, the Ouroboros class of consensus
--- protocols /always/ sticks with the current chain.
-preferCandidate :: ConsensusProtocol p
-                => proxy      p
-                -> SelectView p  -- ^ Tip of our chain
-                -> SelectView p  -- ^ Tip of the candidate
-                -> Bool
-preferCandidate _ ours cand = cand > ours
+-- See 'preferCandidate' for the primary documentation.
+--
+-- Additionally, we require a total order on this type, such that eg different
+-- candidate chains that are preferred over our current selection can be sorted
+-- for prioritization. For example, this is used in ChainSel during initial
+-- chain selection or when blocks arrive out of order (not the case when the
+-- node is caught up), or in the BlockFetch decision logic. Future work could
+-- include also recording\/storing arrival information and using that instead
+-- of\/in addition to the 'Ord' instance.
+class Ord sv => ChainOrder sv where
+  type ChainOrderConfig sv :: Type
+
+  -- | Compare a candidate chain to our own.
+  --
+  -- This method defines when a candidate chain is /strictly/ preferable to our
+  -- current chain. If both chains are equally preferable, the Ouroboros class
+  -- of consensus protocols /always/ sticks with the current chain.
+  --
+  -- === Requirements
+  --
+  -- Write @ours ⊏ cand@ for @'preferCandidate' cfg ours cand@ for brevity.
+  --
+  --  [__Consistency with 'Ord'__]: When @ours ⊏ cand@, then @ours < cand@.
+  --
+  --      This means that @cand@ can only be preferred over @ours@ when @cand@
+  --      is greater than @ours@ according to the 'Ord' instance.
+  --
+  --      However, this is not necessarily a sufficient condition; a concrete
+  --      implementation may decide to not have @ours ⊏ cand@ despite @ours <
+  --      cand@ for some pairs @ours, can@. However, it is recommended to think
+  --      about this carefully and rather use 'SimpleChainOrder' if possible,
+  --      which defines @ours ⊏ cand@ as @ours < cand@, as it simplifies
+  --      reasoning about the chain ordering.
+  --
+  --      However, forgoing 'SimpleChainOrder' can enable more sophisticated
+  --      tiebreaking rules that eg exhibit desirable incentive behavior.
+  --
+  --  [__Chain extension precedence__]: @a@ must contain the underlying block
+  --      number, and use this as the primary way of comparing chains.
+  --
+  --      Suppose that we have a function @blockNo :: sv -> Natural@. Then for
+  --      all @a, b@ with @blockNo a < blockNo b@ we must have @a ⊏ b@.
+  --
+  --      Intuitively, this means that only the logic for breaking ties between
+  --      chains with equal block number is customizable via this class.
+  preferCandidate ::
+       ChainOrderConfig sv
+    -> sv -- ^ Tip of our chain
+    -> sv -- ^ Tip of the candidate
+    -> Bool
+
+-- | A @DerivingVia@ helper to implement 'preferCandidate' in terms of the 'Ord'
+-- instance.
+newtype SimpleChainOrder sv = SimpleChainOrder sv
+  deriving newtype (Eq, Ord)
+
+instance Ord sv => ChainOrder (SimpleChainOrder sv) where
+  type ChainOrderConfig (SimpleChainOrder sv) = ()
+
+  preferCandidate _cfg ours cand = ours < cand
+
+deriving via SimpleChainOrder BlockNo instance ChainOrder BlockNo
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs
index e123000d01..c9583fe3c8 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/MockChainSel.hs
@@ -31,11 +31,12 @@ import qualified Ouroboros.Network.Mock.Chain as Chain
 -- Returns 'Nothing' if we stick with our current chain.
 selectChain :: forall proxy p hdr l. ConsensusProtocol p
             => proxy p
+            -> ChainOrderConfig (SelectView p)
             -> (hdr -> SelectView p)
             -> Chain hdr           -- ^ Our chain
             -> [(Chain hdr, l)]    -- ^ Upstream chains
             -> Maybe (Chain hdr, l)
-selectChain p view ours =
+selectChain _ cfg view ours =
       listToMaybe
     . map snd
     . sortOn (Down . fst)
@@ -53,7 +54,7 @@ selectChain p view ours =
             -> Just (view candTip, x)
           (Just ourTip, Just candTip)
             | let candView = view candTip
-            , preferCandidate p (view ourTip) candView
+            , preferCandidate cfg (view ourTip) candView
             -> Just (candView, x)
           _otherwise
             -> Nothing
@@ -61,11 +62,12 @@ selectChain p view ours =
 -- | Chain selection on unvalidated chains
 selectUnvalidatedChain :: ConsensusProtocol p
                        => proxy p
+                       -> ChainOrderConfig (SelectView p)
                        -> (hdr -> SelectView p)
                        -> Chain hdr
                        -> [Chain hdr]
                        -> Maybe (Chain hdr)
-selectUnvalidatedChain p view ours =
+selectUnvalidatedChain p cfg view ours =
       fmap fst
-    . selectChain p view ours
+    . selectChain p cfg view ours
     . map (, ())
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs
index 4d8a51dbb9..443a759c0e 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs
@@ -21,7 +21,7 @@ newtype instance ConsensusConfig (ModChainSel p s) = McsConsensusConfig {
   deriving (Generic)
 
 instance ( ConsensusProtocol p
-         , Ord  s
+         , ChainOrder s
          , Show s
          , Typeable s
          , NoThunks s
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs
index cad66c5127..ba888bab31 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass            #-}
 {-# LANGUAGE DeriveGeneric             #-}
+{-# LANGUAGE DerivingVia               #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE FlexibleInstances         #-}
@@ -135,7 +136,9 @@ data PBftSelectView = PBftSelectView {
       pbftSelectViewBlockNo :: BlockNo
     , pbftSelectViewIsEBB   :: IsEBB
     }
-  deriving (Show, Eq, Generic, NoThunks)
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NoThunks)
+  deriving (ChainOrder) via SimpleChainOrder PBftSelectView
 
 mkPBftSelectView :: GetHeader blk => Header blk -> PBftSelectView
 mkPBftSelectView hdr = PBftSelectView {
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs
index 160862d7e1..ae6d091b3d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs
@@ -25,6 +25,7 @@ module Ouroboros.Consensus.TypeFamilyWrappers (
     -- * Protocol based
   , WrapCanBeLeader (..)
   , WrapChainDepState (..)
+  , WrapChainOrderConfig (..)
   , WrapConsensusConfig (..)
   , WrapIsLeader (..)
   , WrapLedgerView (..)
@@ -84,14 +85,15 @@ newtype WrapValidatedGenTx        blk = WrapValidatedGenTx        { unwrapValida
   Consensus based
 -------------------------------------------------------------------------------}
 
-newtype WrapCanBeLeader     blk = WrapCanBeLeader     { unwrapCanBeLeader     :: CanBeLeader     (BlockProtocol blk) }
-newtype WrapChainDepState   blk = WrapChainDepState   { unwrapChainDepState   :: ChainDepState   (BlockProtocol blk) }
-newtype WrapConsensusConfig blk = WrapConsensusConfig { unwrapConsensusConfig :: ConsensusConfig (BlockProtocol blk) }
-newtype WrapIsLeader        blk = WrapIsLeader        { unwrapIsLeader        :: IsLeader        (BlockProtocol blk) }
-newtype WrapLedgerView      blk = WrapLedgerView      { unwrapLedgerView      :: LedgerView      (BlockProtocol blk) }
-newtype WrapSelectView      blk = WrapSelectView      { unwrapSelectView      :: SelectView      (BlockProtocol blk) }
-newtype WrapValidateView    blk = WrapValidateView    { unwrapValidateView    :: ValidateView    (BlockProtocol blk) }
-newtype WrapValidationErr   blk = WrapValidationErr   { unwrapValidationErr   :: ValidationErr   (BlockProtocol blk) }
+newtype WrapCanBeLeader      blk = WrapCanBeLeader      { unwrapCanBeLeader      :: CanBeLeader                  (BlockProtocol blk)  }
+newtype WrapChainDepState    blk = WrapChainDepState    { unwrapChainDepState    :: ChainDepState                (BlockProtocol blk)  }
+newtype WrapChainOrderConfig blk = WrapChainOrderConfig { unwrapChainOrderConfig :: ChainOrderConfig (SelectView (BlockProtocol blk)) }
+newtype WrapConsensusConfig  blk = WrapConsensusConfig  { unwrapConsensusConfig  :: ConsensusConfig              (BlockProtocol blk)  }
+newtype WrapIsLeader         blk = WrapIsLeader         { unwrapIsLeader         :: IsLeader                     (BlockProtocol blk)  }
+newtype WrapLedgerView       blk = WrapLedgerView       { unwrapLedgerView       :: LedgerView                   (BlockProtocol blk)  }
+newtype WrapSelectView       blk = WrapSelectView       { unwrapSelectView       :: SelectView                   (BlockProtocol blk)  }
+newtype WrapValidateView     blk = WrapValidateView     { unwrapValidateView     :: ValidateView                 (BlockProtocol blk)  }
+newtype WrapValidationErr    blk = WrapValidationErr    { unwrapValidationErr    :: ValidationErr                (BlockProtocol blk)  }
 
 {-------------------------------------------------------------------------------
   Versioning
@@ -149,6 +151,8 @@ deriving instance Eq (ValidationErr (BlockProtocol blk)) => Eq (WrapValidationEr
 
 deriving instance Ord (SelectView (BlockProtocol blk)) => Ord (WrapSelectView blk)
 
+deriving instance ChainOrder (SelectView (BlockProtocol blk)) => ChainOrder (WrapSelectView blk)
+
 deriving instance Show (ChainDepState (BlockProtocol blk)) => Show (WrapChainDepState blk)
 deriving instance Show (LedgerView    (BlockProtocol blk)) => Show (WrapLedgerView    blk)
 deriving instance Show (SelectView    (BlockProtocol blk)) => Show (WrapSelectView    blk)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
index ee757ef5c2..7e92f5233d 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/AnchoredFragment.hs
@@ -22,6 +22,7 @@ import           Data.Maybe (isJust)
 import           Data.Word (Word64)
 import           GHC.Stack
 import           Ouroboros.Consensus.Block
+import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Util.Assert
 import           Ouroboros.Network.AnchoredFragment (AnchoredFragment,
                      AnchoredSeq (Empty, (:>)))
@@ -72,16 +73,12 @@ forksAtMostKBlocks k ours theirs = case ours `AF.intersect` theirs of
 -- For a detailed discussion of this precondition, and a justification for the
 -- definition of this function, please refer to the Consensus Report.
 --
--- Usage note: the primary user of this function is the chain database. It
--- establishes the precondition in two different ways:
---
--- * When comparing a candidate fragment to our current chain, the fragment is
---   guaranteed (by the chain sync client) to intersect with our chain (indeed,
---   within at most @k@ blocks from our tip, although the exact distance does
---   not matter for 'compareAnchoredFragments').
--- * It will only compare candidate fragments that it has previously verified
---   are preferable to our current chain. Since these fragments intersect with
---   our current chain, they must by transitivity also intersect each other.
+-- Usage note: the primary user of this function is the chain database when
+-- sorting fragments that are preferred over our selection. It establishes the
+-- precondition in the following way: It will only compare candidate fragments
+-- that it has previously verified are preferable to our current chain. Since
+-- these fragments intersect with our current chain, they must by transitivity
+-- also intersect each other.
 compareAnchoredFragments ::
      forall blk. (BlockSupportsProtocol blk, HasCallStack)
   => BlockConfig blk
@@ -89,7 +86,7 @@ compareAnchoredFragments ::
   -> AnchoredFragment (Header blk)
   -> Ordering
 compareAnchoredFragments cfg frag1 frag2 =
-    assertWithMsg precondition $
+    assertWithMsg (precondition frag1 frag2) $
     case (frag1, frag2) of
       (Empty _, Empty _) ->
         -- The fragments intersect but are equal: their anchors must be equal,
@@ -115,21 +112,17 @@ compareAnchoredFragments cfg frag1 frag2 =
         compare
           (selectView cfg tip)
           (selectView cfg tip')
-  where
-    precondition :: Either String ()
-    precondition
-      | not (AF.null frag1), not (AF.null frag2)
-      = return ()
-      | isJust (AF.intersectionPoint frag1 frag2)
-      = return ()
-      | otherwise
-      = throwError
-          "precondition violated: fragments should both be non-empty or they \
-          \should intersect"
 
 -- | Lift 'preferCandidate' to 'AnchoredFragment'
 --
--- See discussion for 'compareAnchoredFragments'.
+-- PRECONDITION: Either both fragments are non-empty or they intersect.
+--
+-- Usage note: the primary user of this function is the chain database. It
+-- establishes the precondition when comparing a candidate fragment to our
+-- current chain in the following way: The fragment is guaranteed (by the chain
+-- sync client) to intersect with our chain (indeed, within at most @k@ blocks
+-- from our tip, although the exact distance does not matter for
+-- 'compareAnchoredFragments').
 preferAnchoredCandidate ::
      forall blk. (BlockSupportsProtocol blk, HasCallStack)
   => BlockConfig blk
@@ -137,7 +130,32 @@ preferAnchoredCandidate ::
   -> AnchoredFragment (Header blk)      -- ^ Candidate
   -> Bool
 preferAnchoredCandidate cfg ours cand =
-    compareAnchoredFragments cfg ours cand == LT
+    assertWithMsg (precondition ours cand) $
+    case (ours, cand) of
+      (_, Empty _) -> False
+      (Empty ourAnchor, _ :> theirTip) ->
+        blockPoint theirTip /= AF.anchorToPoint ourAnchor
+      (_ :> ourTip, _ :> theirTip) ->
+        preferCandidate
+          (projectChainOrderConfig cfg)
+          (selectView cfg ourTip)
+          (selectView cfg theirTip)
+
+-- For 'compareAnchoredFragment' and 'preferAnchoredCandidate'.
+precondition ::
+     GetHeader blk
+  => AnchoredFragment (Header blk)
+  -> AnchoredFragment (Header blk)
+  -> Either String ()
+precondition frag1 frag2
+  | not (AF.null frag1), not (AF.null frag2)
+  = return ()
+  | isJust (AF.intersectionPoint frag1 frag2)
+  = return ()
+  | otherwise
+  = throwError
+      "precondition violated: fragments should both be non-empty or they \
+      \should intersect"
 
 -- | If the two fragments `c1` and `c2` intersect, return the intersection
 -- point and join the prefix of `c1` before the intersection with the suffix
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/Protocol.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/Protocol.hs
new file mode 100644
index 0000000000..2a8596c131
--- /dev/null
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Consensus/Protocol.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Test.Ouroboros.Consensus.Protocol (tests_chainOrder) where
+
+import           Data.Proxy
+import           Data.Typeable (Typeable, typeRep)
+import           Ouroboros.Consensus.Protocol.Abstract
+import           Test.Tasty
+import           Test.Tasty.QuickCheck
+import           Test.Util.QuickCheck
+
+-- | Test the laws of the 'ChainOrder' class (in particular, that 'Ord' is
+-- lawful) /except/ for the high-level "Chain extension precedence" property.
+tests_chainOrder ::
+     forall a.
+     ( ChainOrder a
+     , Typeable a
+     , Arbitrary a
+     , Show a
+     , Arbitrary (ChainOrderConfig a)
+     , Show (ChainOrderConfig a)
+     )
+  => Proxy a
+  -> TestTree
+tests_chainOrder aPrx = testGroup ("ChainOrder " <> show (typeRep aPrx))
+    [ testProperty "Eq & Ord" (prop_lawfulEqAndTotalOrd @a)
+    , testProperty "Consistency with Ord" $ \cfg (a :: a) b ->
+        preferCandidate cfg a b ==> a `lt` b
+    ]
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/QuickCheck.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/QuickCheck.hs
index 9df9ef363b..32d7afc116 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/QuickCheck.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/QuickCheck.hs
@@ -28,6 +28,9 @@ module Test.Util.QuickCheck (
     -- * Convenience
   , collects
   , forAllGenRunShrinkCheck
+  , implies
+    -- * Typeclass laws
+  , prop_lawfulEqAndTotalOrd
   ) where
 
 import           Control.Monad.Except
@@ -218,3 +221,49 @@ shrinkNP g f np = npToSListI np $ cshrinkNP (Proxy @Top) g f np
 
 collects :: Show a => [a] -> Property -> Property
 collects = repeatedly collect
+
+-- | QuickCheck's '==>' 'discard's the test if @p1@ fails; this is sometimes not
+-- what we want, for example if we have other properties that do not depend on
+-- @p1@ being true.
+implies :: Testable prop => Bool -> prop -> Property
+implies p1 p2 = not p1 .||. p2
+infixr 0 `implies`
+
+{-------------------------------------------------------------------------------
+  Typeclass laws
+-------------------------------------------------------------------------------}
+
+prop_lawfulEqAndTotalOrd ::
+     forall a. (Show a, Ord a)
+  => a -> a -> a -> Property
+prop_lawfulEqAndTotalOrd a b c = conjoin
+    [ counterexample "Not total: a <= b || b <= a VIOLATED" $
+        a <= b || b <= a
+    , counterexample "Not transitive: a <= b && b <= c => a <= c VIOLATED" $
+        let antecedent = a <= b && b <= c in
+        classify antecedent "Antecedent for transitivity" $
+        antecedent `implies` a <= c
+    , counterexample "Not reflexive: a <= a VIOLATED" $
+        a `le` a
+    , counterexample "Not antisymmetric: a <= b && b <= a => a == b VIOLATED" $
+        let antecedent = a <= b && b <= a in
+        classify antecedent "Antecedent for antisymmetry" $
+        antecedent `implies` a == b
+    , -- compatibility laws
+      counterexample "(a <= b) == (b >= a) VIOLATED" $
+        (a <= b) === (b >= a)
+    , counterexample "(a < b) == (a <= b && a /= b) VIOLATED" $
+        (a < b) === (a <= b && a /= b)
+    , counterexample "(a > b) = (b < a) VIOLATED" $
+        (a > b) === (b < a)
+    , counterexample "(a < b) == (compare a b == LT) VIOLATED" $
+        (a < b) === (compare a b == LT)
+    , counterexample "(a > b) == (compare a b == GT) VIOLATED" $
+        (a > b) === (compare a b == GT)
+    , counterexample "(a == b) == (compare a b == EQ) VIOLATED" $
+        (a == b) === (compare a b == EQ)
+    , counterexample "min a b == if a <= b then a else b VIOLATED" $
+        min a b === if a <= b then a else b
+    , counterexample "max a b == if a >= b then a else b VIOLATED" $
+        max a b === if a >= b then a else b
+    ]
diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
index 23384b9d7a..7abc66cea4 100644
--- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
+++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs
@@ -123,6 +123,7 @@ import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.NodeId
+import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.BFT
 import           Ouroboros.Consensus.Protocol.MockChainSel
 import           Ouroboros.Consensus.Protocol.Signed
@@ -748,6 +749,7 @@ treePreferredChain =
       fromMaybe Genesis
     . selectUnvalidatedChain
         (Proxy @(BlockProtocol TestBlock))
+        (() :: ChainOrderConfig (SelectView (BlockProtocol TestBlock)))
         blockNo
         Genesis
     . treeToChains
diff --git a/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs b/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs
index 197b0b281d..69af4e6f8d 100644
--- a/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs
+++ b/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs
@@ -178,7 +178,8 @@ The `preferCandidate` function in `Ouroboros.Consensus.Protocol.Abstract`
 demonstrates how this is used.
 
 Note that instantiations of `ConsensusProtocol` for some protocol `p`
-consequently requires `Ord (SelectView p)`.
+consequently requires `ChainOrder (SelectView p)` (which in particular requires
+`Ord (SelectView p)`.
 
 For `SP` we will use only `BlockNo` - to implement the simplest rule of
 preferring longer chains to shorter chains.
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
index d6894e0053..d7fac62ee2 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/ChainDB/Model.hs
@@ -437,6 +437,7 @@ addBlock cfg blk m = Model {
         fromMaybe (currentChain m, currentLedger m)
       . selectChain
           (Proxy @(BlockProtocol blk))
+          (projectChainOrderConfig (configBlock cfg))
           (selectView (configBlock cfg) . getHeader)
           (currentChain m)
       $ consideredCandidates
@@ -1004,6 +1005,7 @@ wipeVolatileDB cfg m =
         isSameAsImmutableDbChain
       $ selectChain
           (Proxy @(BlockProtocol blk))
+          (projectChainOrderConfig (configBlock cfg))
           (selectView (configBlock cfg) . getHeader)
           Chain.genesis
       $ snd
diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
index a7bef650d1..7ffeb6c885 100644
--- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
+++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/TestBlock.hs
@@ -97,6 +97,7 @@ import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.NodeId
+import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.BFT
 import           Ouroboros.Consensus.Protocol.ModChainSel
 import           Ouroboros.Consensus.Protocol.Signed
@@ -459,7 +460,9 @@ data BftWithEBBsSelectView = BftWithEBBsSelectView {
     , bebbChainLength :: !ChainLength
     , bebbHash        :: !TestHeaderHash
     }
-  deriving (Show, Eq, Generic, NoThunks)
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NoThunks)
+  deriving (ChainOrder) via SimpleChainOrder BftWithEBBsSelectView
 
 instance Ord BftWithEBBsSelectView where
   compare (BftWithEBBsSelectView lBlockNo lIsEBB lChainLength lHash)