allow slot or points for --until.

Author: KtorZ

src/Kupo.hs

@@ -118,6 +118,7 @@ import Kupo.Data.Configuration
     , DeferIndexesInstallation (..)
     , NodeTipHasBeenReachedException (..)
     , isReadOnlyReplica
+    , untilPredicate
     )
 import Kupo.Data.FetchBlock
     ( FetchBlockClient
@@ -267,7 +268,7 @@ kupoWith tr withProducer withFetchBlock =
                             mailbox
                             patterns
                             db
-                            (maybe rollForwardAll rollForwardUntil until)
+                            (maybe rollForwardAll (rollForwardUntil . untilPredicate) until)
                     )
 
                     -- Database garbage-collector

src/Kupo/App.hs

@@ -445,10 +445,10 @@ rollForwardUntil
         , Monad (DBTransaction m)
         , IsBlock block
         )
-    => SlotNo
+    => (Point -> Bool)
     -> RollForward m block
 rollForwardUntil until tr inputManagement notifyTip database patterns blks = do
-    let blksBefore = NE.takeWhile ((<= until) . getPointSlotNo . getPoint . snd) blks
+    let blksBefore = NE.takeWhile (until . getPoint . snd) blks
     whenJust (nonEmpty blksBefore) $
         rollForwardAll tr inputManagement notifyTip database patterns
 

src/Kupo/Data/Configuration.hs

@@ -14,6 +14,8 @@ module Kupo.Data.Configuration
       Configuration (..)
     , DatabaseLocation (..)
     , Since (..)
+    , Until (..)
+    , untilPredicate
     , InputManagement (..)
     , ChainProducer (..)
     , LongestRollback (..)
@@ -58,6 +60,7 @@ import Kupo.Control.MonadTime
 import Kupo.Data.Cardano
     ( Point
     , SlotNo
+    , getPointSlotNo
     )
 import Kupo.Data.Pattern
     ( Pattern (..)
@@ -93,7 +96,7 @@ data Configuration = Configuration
         -- ^ Port for the API HTTP Server
     , since :: !(Maybe Since)
         -- ^ Point from when a *new* synchronization should start
-    , until :: !(Maybe SlotNo)
+    , until :: !(Maybe Until)
         -- ^ Slot at which to stop indexing and just serve queries
     , patterns :: !(Set Pattern)
         -- ^ List of address patterns to look for when synchronizing
@@ -149,6 +152,15 @@ data ChainProducer
 data Since = SinceTip | SincePoint Point
     deriving (Generic, Eq, Show)
 
+-- | Captures the point up-to which synchronize.
+data Until = UntilPoint Point | UntilSlot SlotNo
+    deriving (Generic, Eq, Show)
+
+untilPredicate :: Until -> Point -> Bool
+untilPredicate = \case
+    UntilPoint until -> (<= until)
+    UntilSlot until -> (<= until) . getPointSlotNo
+
 -- | Database working directory. 'in-memory' runs the database in hot memory,
 -- only suitable for non-permissive patterns or testing.
 data DatabaseLocation

src/Kupo/Options.hs

@@ -64,8 +64,7 @@ import Kupo.Control.MonadTime
     , secondsToDiffTime
     )
 import Kupo.Data.Cardano
-    ( SlotNo
-    , pointFromText
+    ( pointFromText
     , slotNoFromText
     )
 import Kupo.Data.Configuration
@@ -75,6 +74,7 @@ import Kupo.Data.Configuration
     , DeferIndexesInstallation (..)
     , InputManagement (..)
     , Since (..)
+    , Until (..)
     )
 import Kupo.Data.Pattern
     ( Pattern
@@ -102,9 +102,9 @@ import Text.URI
     ( URI
     )
 
-import qualified Text.URI as URI
 import qualified Data.Text as T
 import qualified Data.Text.Read as T
+import qualified Text.URI as URI
 
 data Command
     = Run !Configuration !(Tracers IO MinSeverities)
@@ -312,13 +312,16 @@ sinceOption = option (maybeReader rdr) $ mempty
     rdr s = fmap SincePoint (pointFromText $ toText s)
 
 -- | [--until=SLOT]
-untilOption :: Parser SlotNo
-untilOption = option (maybeReader (slotNoFromText . toText)) $ mempty
+untilOption :: Parser Until
+untilOption = option (maybeReader asSlot <|> maybeReader asPoint) $ mempty
     <> long "until"
-    <> metavar "SLOT"
+    <> metavar "POINT|SLOT"
     <> helpDoc (Just $ mconcat
-        [ "A slot (inclusive) to sync up-to. Useful for getting point in time snapshots."
+        [ "A point or slot (inclusive) to sync up-to. Useful for getting point in time snapshots."
         ])
+  where
+    asSlot = fmap UntilSlot . slotNoFromText . toText
+    asPoint = fmap UntilPoint . pointFromText . toText
 
 -- | [--match=PATTERN]
 patternOption :: Parser Pattern

test/Test/KupoSpec.hs

@@ -179,6 +179,7 @@ import Control.Monad.Class.MonadThrow
     )
 import Kupo.Data.Configuration
     ( Since (..)
+    , Until (..)
     )
 import Kupo.Data.Health
     ( ConnectionStatus (..)
@@ -591,7 +592,7 @@ spec = skippableContext "End-to-end" $ do
                                -- if we don't want `waitSlot` down below to be waiting forever!
         (_, env) <- configure $ \defaultCfg -> defaultCfg
             { since = Just (SincePoint somePoint)
-            , until = Just maxSlot
+            , until = Just (UntilSlot maxSlot)
             , patterns = fromList [MatchAny IncludingBootstrap]
             , deferIndexes = SkipNonEssentialIndexes
             }