genesis/origin no slot number, ouroboros-consensus

Follow-up to pointSlot type change in ouroboros-network, to make
ouroboros-consensus build and tests pass.

Must be reviewed by someone more familiar with ouroboros-consensus. I've
probably made some changes that aren't right.

ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs

@@ -31,7 +31,8 @@ import           Control.Monad.Class.MonadThrow
 import           Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block
-import           Ouroboros.Network.Chain (genesisPoint, genesisSlotNo)
+import           Ouroboros.Network.Chain (genesisPoint)
+import           Ouroboros.Network.Point (WithOrigin (..))
 import           Ouroboros.Network.Protocol.ChainSync.Client
 
 import           Ouroboros.Consensus.Block
@@ -302,7 +303,7 @@ chainSyncClient tracer cfg btime (ClockSkew maxSkew)
 
       -- Get the 'ChainState' at genesis.
       let candidateChain' = Empty genesisPoint
-      candidateChainState' <- case rewindChainState cfg curChainState genesisSlotNo of
+      candidateChainState' <- case rewindChainState cfg curChainState Origin of
         Nothing -> disconnect $ ForkTooDeep genesisPoint theirHead
         Just c  -> pure c
 
@@ -391,13 +392,17 @@ chainSyncClient tracer cfg btime (ClockSkew maxSkew)
           -- TODO: Chain sync Client: Reuse anachronistic ledger view? #581
           case anachronisticProtocolLedgerView cfg curLedger (pointSlot hdrPoint) of
             Nothing   -> retry
-            Just view -> case view `SB.at` pointSlot hdrPoint of
+            Just view -> case view `SB.at` hdrSlot of
               Nothing -> error "anachronisticProtocolLedgerView invariant violated"
               Just lv -> return lv
+              where
+              hdrSlot = case pointSlot hdrPoint of
+                Origin      -> SlotNo 0
+                At thisSlot -> thisSlot
 
       -- Check for clock skew
       wallclock <- getCurrentSlot btime
-      when (unSlotNo (pointSlot hdrPoint) > unSlotNo wallclock + maxSkew) $
+      when (fmap unSlotNo (pointSlot hdrPoint) > At (unSlotNo wallclock + maxSkew)) $
         disconnect $ HeaderExceedsClockSkew hdrPoint wallclock
 
       -- Validate header

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs

@@ -13,6 +13,7 @@ module Ouroboros.Consensus.Ledger.Abstract (
 import           Control.Monad.Except
 
 import           Ouroboros.Network.Block (Point, SlotNo)
+import           Ouroboros.Network.Point (WithOrigin)
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -115,5 +116,5 @@ class UpdateLedger blk => ProtocolLedgerView blk where
   anachronisticProtocolLedgerView
     :: NodeConfig (BlockProtocol blk)
     -> LedgerState blk
-    -> SlotNo -- ^ Slot for which you would like a ledger view
+    -> WithOrigin SlotNo -- ^ Slot for which you would like a ledger view
     -> Maybe (SlotBounded (LedgerView (BlockProtocol blk)))

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs

@@ -78,8 +78,8 @@ import           Cardano.Crypto.DSIGN
 import           Cardano.Crypto.Hash
 
 import           Ouroboros.Network.Block
-import           Ouroboros.Network.Chain (genesisSlotNo)
 import qualified Ouroboros.Network.Point as Point (block, origin)
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Crypto.DSIGN.Cardano
@@ -354,10 +354,10 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg)
                 <$> sb
         -- No snapshot - we could be in the past or in the future
         Nothing
-          | slot >= lvLB && slot <= lvUB
+          | slot >= At lvLB && slot <= At lvUB
           -> Just $ PBftLedgerView <$>
              case Seq.takeWhileL
-                    (\sd -> convertSlot (V.Scheduling.sdSlot sd) <= slot)
+                    (\sd -> At (convertSlot (V.Scheduling.sdSlot sd)) <= slot)
                     dsScheduled of
                 -- No updates to apply. So the current ledger state is valid
                 -- from the end of the last snapshot to the first scheduled
@@ -385,7 +385,7 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg)
       lvUB = SlotNo $ unSlotNo currentSlot + (2 * paramK)
       lvLB
         | 2 * paramK > unSlotNo currentSlot
-        = genesisSlotNo
+        = SlotNo 0
         | otherwise
         = SlotNo $ unSlotNo currentSlot - (2 * paramK)
 
@@ -398,7 +398,7 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg)
                   . CC.Block.cvsDelegationState
                   $ ls
       currentSlot = convertSlot $ CC.Block.cvsLastSlot ls
-      containsSlot s sb = sbLower sb <= s && sbUpper sb >= s
+      containsSlot s sb = At (sbLower sb) <= s && At (sbUpper sb) >= s
 
 {-------------------------------------------------------------------------------
   Mempool integration

ouroboros-consensus/src/Ouroboros/Consensus/Node.hs

@@ -39,6 +39,7 @@ import           Ouroboros.Network.Block
 import           Ouroboros.Network.BlockFetch
 import           Ouroboros.Network.BlockFetch.State (FetchMode (..))
 import qualified Ouroboros.Network.Chain as Chain
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.BlockchainTime
@@ -261,7 +262,11 @@ initBlockFetchConsensusInterface tracer cfg chainDB getCandidates blockFetchSize
     readFetchMode = do
       curSlot      <- getCurrentSlot btime
       curChainSlot <- headSlot <$> ChainDB.getCurrentChain chainDB
-      let slotsBehind = unSlotNo curSlot - unSlotNo curChainSlot
+      let slotsBehind = case curChainSlot of
+            -- There's nothing in the chain. If the current slot is 0, then
+            -- we're 1 slot behind.
+            Origin  -> unSlotNo curSlot + 1
+            At slot -> unSlotNo curSlot - unSlotNo slot
           maxBlocksBehind = 5
           -- Convert from blocks to slots. This is more or less the @f@
           -- parameter, the frequency of blocks. TODO should be 10 for Praos,

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs

@@ -46,6 +46,7 @@ import           Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block (HasHeader (..), SlotNo (..))
 import           Ouroboros.Network.Chain (Chain)
+import           Ouroboros.Network.Point (WithOrigin)
 
 import qualified Ouroboros.Consensus.Util.AnchoredFragment as AF
 import           Ouroboros.Consensus.Util.Random
@@ -177,7 +178,7 @@ class ( Show (ChainState    p)
   -- blocks.
   --
   -- This function should attempt to rewind the chain state to the state at some
-  -- given slot.
+  -- given slot, or Origin to rewind to the state with no blocks.
   --
   -- Implementers should take care that this function accurately reflects the
   -- slot number, rather than the number of blocks, since naively the
@@ -197,7 +198,7 @@ class ( Show (ChainState    p)
   -- and will yield 'Nothing'.
   rewindChainState :: NodeConfig p
                    -> ChainState p
-                   -> SlotNo -- ^ Slot to rewind to.
+                   -> WithOrigin SlotNo -- ^ Slot to rewind to.
                    -> Maybe (ChainState p)
 
 -- | Protocol security parameter

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs

@@ -47,6 +47,7 @@ import           Cardano.Crypto.DSIGN.Class
 import           Cardano.Crypto.DSIGN.Mock (MockDSIGN)
 
 import           Ouroboros.Network.Block
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Crypto.DSIGN.Cardano
 import           Ouroboros.Consensus.NodeId (NodeId (..))
@@ -213,8 +214,9 @@ instance (PBftCrypto c, Typeable c) => OuroborosTag (PBft c) where
       takeR :: Integral i => i -> Seq a -> Seq a
       takeR (fromIntegral -> n) s = Seq.drop (Seq.length s - n - 1) s
 
-  rewindChainState _ cs slot = if slot == SlotNo 0 then Just Seq.empty else
-    case Seq.takeWhileL (\(_, s) -> s <= slot) cs of
+  rewindChainState _ cs mSlot = case mSlot of
+    Origin  -> Just Seq.empty
+    At slot -> case Seq.takeWhileL (\(_, s) -> s <= slot) cs of
         _ Seq.:<| _ -> Just cs
         _           -> Nothing
 

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Praos.hs

@@ -57,6 +57,7 @@ import           Cardano.Crypto.VRF.Mock (MockVRF)
 import           Cardano.Crypto.VRF.Simple (SimpleVRF)
 
 import           Ouroboros.Network.Block (HasHeader (..), SlotNo (..))
+import           Ouroboros.Network.Point (WithOrigin (At))
 
 import           Ouroboros.Consensus.NodeId (CoreNodeId (..), NodeId (..))
 import           Ouroboros.Consensus.Protocol.Abstract
@@ -293,7 +294,7 @@ instance PraosCrypto c => OuroborosTag (Praos c) where
   -- filled; instead we roll back the the block just before it.
   rewindChainState PraosNodeConfig{..} cs rewindTo =
       -- This may drop us back to the empty list if we go back to genesis
-      Just $ dropWhile (\bi -> biSlot bi > rewindTo) cs
+      Just $ dropWhile (\bi -> At (biSlot bi) > rewindTo) cs
 
   -- NOTE: We redefine `preferCandidate` but NOT `compareCandidates`
   -- NOTE: See note regarding clock skew.

ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Background.hs

@@ -46,6 +46,7 @@ import           Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block (ChainHash (..), HasHeader, Point,
                      SlotNo, StandardHash, pointHash, pointSlot)
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Ledger.Abstract (ProtocolLedgerView)
@@ -118,7 +119,7 @@ copyToImmDB
      , HasCallStack
      )
   => ChainDbEnv m blk
-  -> m SlotNo
+  -> m (WithOrigin SlotNo)
 copyToImmDB CDB{..} = withCopyLock $ do
     toCopy <- atomically $ do
       curChain <- readTVar cdbChain
@@ -206,8 +207,10 @@ copyToImmDBRunner cdb@CDB{..} gcSchedule = forever $ do
       curChain <- readTVar cdbChain
       check $ fromIntegral (AF.length curChain) > k
 
-    slotNo <- copyToImmDB cdb
-    scheduleGC (contramap TraceGCEvent cdbTracer) slotNo cdbGcDelay gcSchedule
+    mSlotNo <- copyToImmDB cdb
+    case mSlotNo of
+      Origin    -> pure ()
+      At slotNo -> scheduleGC (contramap TraceGCEvent cdbTracer) slotNo cdbGcDelay gcSchedule
   where
     SecurityParam k = protocolSecurityParam cdbNodeConfig
 
@@ -238,7 +241,7 @@ garbageCollect CDB{..} slotNo = do
     VolDB.garbageCollect cdbVolDB slotNo
     atomically $ do
       LgrDB.garbageCollectPrevApplied cdbLgrDB slotNo
-      modifyTVar' cdbInvalid $ Set.filter ((<= slotNo) . pointSlot)
+      modifyTVar' cdbInvalid $ Set.filter ((<= At slotNo) . pointSlot)
     traceWith cdbTracer $ TraceGCEvent $ PerformedGC slotNo
 
 {-------------------------------------------------------------------------------

ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/ImmDB.hs

@@ -55,11 +55,12 @@ import           Control.Monad.Class.MonadST
 import           Control.Monad.Class.MonadSTM
 import           Control.Monad.Class.MonadThrow
 
-import           Ouroboros.Network.Block (pattern BlockPoint, ChainHash (..),
+import           Ouroboros.Network.Block (pattern BlockPoint,
                      pattern GenesisPoint, HasHeader (..), HeaderHash, Point,
-                     SlotNo, atSlot, blockPoint, pointHash, pointSlot,
+                     SlotNo, atSlot, blockPoint, pointSlot,
                      withHash)
-import           Ouroboros.Network.Chain (genesisPoint, genesisSlotNo)
+import           Ouroboros.Network.Chain (genesisPoint)
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import qualified Ouroboros.Consensus.Util.CBOR as Util.CBOR
 
@@ -206,13 +207,13 @@ getPointAtTip = fmap mbBlockToPoint . getBlockAtTip
     mbBlockToPoint (Just blk) = blockPoint blk
 
 getSlotNoAtTip :: (MonadCatch m, HasHeader blk)
-               => ImmDB m blk -> m SlotNo
+               => ImmDB m blk -> m (WithOrigin SlotNo)
 getSlotNoAtTip db = do
     immTip <- withDB db $ \imm -> ImmDB.getTip imm
     case immTip of
-      TipGen             -> return genesisSlotNo
-      Tip (Left epochNo) -> epochInfoFirst epochNo
-      Tip (Right slotNo) -> return slotNo
+      TipGen             -> return Origin
+      Tip (Left epochNo) -> At <$> epochInfoFirst epochNo
+      Tip (Right slotNo) -> return (At slotNo)
   where
     EpochInfo{..} = immEpochInfo db
 
@@ -400,9 +401,9 @@ streamBlobsAfter db low = withDB db $ \imm -> do
     return itr
   where
     low' :: Maybe (SlotNo, HeaderHash blk)
-    low' = case pointHash low of
-             GenesisHash -> Nothing
-             BlockHash h -> Just (pointSlot low, h)
+    low' = case low of
+      GenesisPoint         -> Nothing
+      BlockPoint slot hash -> Just (slot, hash)
 
     -- Skip the first block (if any) to provide an /exclusive/ lower bound
     --

ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs

@@ -61,6 +61,7 @@ import           Control.Tracer
 import           Ouroboros.Network.Block (HasHeader (..), HeaderHash, Point,
                      SlotNo, StandardHash, blockPoint, castPoint)
 import qualified Ouroboros.Network.Block as Block
+import           Ouroboros.Network.Point (WithOrigin (At))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Ledger.Abstract
@@ -383,7 +384,7 @@ garbageCollectPrevApplied :: MonadSTM m
                           -> SlotNo
                           -> STM m ()
 garbageCollectPrevApplied LgrDB{..} slotNo = modifyTVar' varPrevApplied $
-    Set.filter ((<= slotNo) . Block.pointSlot)
+    Set.filter ((<= (At slotNo)) . Block.pointSlot)
 
 {-------------------------------------------------------------------------------
   Error handling

ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/Reader.hs

@@ -32,6 +32,7 @@ import           Ouroboros.Network.Block (ChainUpdate (..), HasHeader,
                      HeaderHash, Point, SlotNo, blockPoint, castPoint,
                      pointSlot)
 import           Ouroboros.Network.Chain (genesisPoint)
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Block (GetHeader (..), headerPoint)
 import           Ouroboros.Consensus.Util.STM (blockUntilJust)
@@ -415,7 +416,7 @@ forward CDB{..} varReader = \pts -> do
     findFirstPointOnChain
       :: HasCallStack
       => AnchoredFragment (Header blk)
-      -> SlotNo
+      -> WithOrigin SlotNo
       -> [Point blk]
       -> m (Maybe (Point blk))
     findFirstPointOnChain curChain slotNoAtImmDBTip = \case

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

@@ -53,6 +53,7 @@ import           Control.Tracer
 import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import           Ouroboros.Network.Block (BlockNo, HasHeader, HeaderHash, Point,
                      SlotNo, StandardHash)
+import           Ouroboros.Network.Point (WithOrigin)
 
 import           Ouroboros.Consensus.Block (BlockProtocol, Header)
 import           Ouroboros.Consensus.Ledger.Abstract (ProtocolLedgerView)
@@ -236,7 +237,7 @@ data Internal m blk = Internal
     --
     -- The 'Bool' arguments indicates whether the background tasks should be
     -- relaunched after reopening the ChainDB.
-  , intCopyToImmDB           :: m SlotNo
+  , intCopyToImmDB           :: m (WithOrigin SlotNo)
     -- ^ Copy the blocks older than @k@ from to the VolatileDB to the
     -- ImmutableDB and update the in-memory chain fragment correspondingly.
     --
@@ -441,14 +442,14 @@ data TraceReaderEvent blk
 
   | ReaderSwitchToMem
     { _readerPoint      :: Point blk
-    , _slotNoAtImmDBTip :: SlotNo
+    , _slotNoAtImmDBTip :: WithOrigin SlotNo
     }
     -- ^ The reader was in the 'ReaderInImmDB' state and is switched to the
     -- 'ReaderInMem' state.
 
   | ReaderNewImmIterator
     { _readerPoint      :: Point blk
-    , _slotNoAtImmDBTip :: SlotNo
+    , _slotNoAtImmDBTip :: WithOrigin SlotNo
     }
     -- ^ The reader is in the 'ReaderInImmDB' state but the iterator is
     -- exhausted while the ImmutableDB has grown, so we open a new iterator to

ouroboros-consensus/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs

@@ -207,8 +207,10 @@ run ChainDB{..} ChainDB.Internal{..} = \case
     ignore _ = Unit ()
 
     runBgTasks = do
-      slotNo <- intCopyToImmDB
-      intGarbageCollect slotNo
+      mSlotNo <- intCopyToImmDB
+      case mSlotNo of
+        Point.Origin    -> pure ()
+        Point.At slotNo -> intGarbageCollect slotNo
       intUpdateLedgerSnapshots
 
 -- | Result type for 'getBlock'. Note that the real implementation of